	.TITLE	VL9
	.psect	VL9

;	stored on:	VL9.MAC
;	last revision:	20-Dec-83

xx1	=	version
xx2	=	options
xx3	=	eis
xx4	=	fis
xx5	=	clock
xx6	=	i11.04
xx7	=	recor

	.globl	abs,addpro,add1,alphle,and,append,appen1,apply,applyn
	.globl	area,ascii,assoc,assq,atom,blki,blki1,blki2,blki3
	.globl	boundp,bstak,bufin,bufou,caaar,caadr,caar,cadar,caddr
	.globl	cadr,car.p,cascii,catoc,catol,cdaar,cdadr,cdar,cddar
	.globl	cdddr,cddr,cdr.p,cntlc,compl,cond,cons,copy,dcons,de,decr
	.globl	delete,delq,df,differ,dm,dmc,dski,dsko,dvd,dvd1
	.globl	enarea,eprogn,eq
	.globl	equal,errm,errmp,errp,escape,eval,evalfu,evalhk,evenp
	.globl	evlis,exch.p,exit,explod,false,form
	.globl	frever,ftype,fval,garb
	.globl	gc,gcspk,ge,get,gt,hdato,hlist,hstak,if,ifn,igc,impli,implod
	.globl	inarea,incr,iniitt,iniodk,iniott,ipti,lambdp,last,le
	.globl	length,list,listp,litato,lmargi,logand,logor,logxor,lsh,lt
	.globl	map,mapc,mapcar,mapcon,maplis,mcons,member,memory,memq
	.globl	msetq,mul32,nblki,nblko,nconc,nconc1,neq,nequal,newl,nextl
	.globl	not,nth,null,numbp,oblist,oddp,or
	.globl	ouarea,oubpk,oubpt,outb
	.globl	outbuf,outpos,outs,pbind,pcrlf,peekch,plengt,plus,popj
	.globl	praise,prch,prin,princh,print,prlgn,prlvl,probj,progn,prog1,prstr
	.globl	ptype,put,quo,rdmaq,rdprd,readch,readli,readu,rem,rempro
	.globl	revers,ringur,rmargi,rplaca,rplacb,rplacd,scale,self
	.globl	seltq,set,setq,setqq,status,subst,sub1,synony,teread
	.globl	terpri,times,trnfrt,trnfr2,true,typech
	.globl	until,where,while,xpldi,zerop

.iif	ne,fis		.globl	fdiff,fix,float,fplus,fquo,ftimes
.iif	ne,clock	.globl	hz50,otime,otime2,time,time2

; MODULE	PAGE	CONTENTS

; VL9		10	****** FICHIERS : radx50.
;		11	****** FICHIERS : FIC, INPUT, OUTPUT, ect.
;		17	****** TRUCS RT-11 DEPENDANTS : TYI, TYS, TYO.
;		18	****** initialisations start, toplevel, reent et ITs.
;		27	****** zones nombres, atomes, listes.
	.page
; ****** FICHIERS : radx50

; ----- radx50	  prends : un pointeur sur une chaine dans a1.
;				une adresse de mot dans a5.
;				la longueur de la chaine dans a2.
;			et colle : les 3 caracteres suivant de la chaine
;				  en format radix50 dans le mot.
;				  en remettant a jour a2 et a1.
;				  si a2 = 0 alors padde a 0.
;
;			tue a3, a4

radx50:	clr	a3		; a3 : accumulateur.
	call	x50
	call	x50
	call	x50
	mov	a3,(a5)		; placer dans le mot dont l'adr. est dans a5.
	clr	a3		; pour gc.
	return			; et bye.

; ----- x50  : used by radx50

x50:	clr	a4		; caractere si chaine epuisee.
	tst	a2		; chaine epuisee ?
	ble	3$		; oui. caractere dans a4 = 0.
	movb	(a1)+,a4	; non. ascii dans a4.
	dec	a2		; R.A.J. longueur de la chaine.
	cmp	a4,#'A		; lettre ?
	blo	1$		; non.
	sub	#<'A-1>,a4	; oui. lettre. a4 = [01:32](8).
	br	3$
1$:	cmp	a4,#'0		; chiffre ?
	blo	2$		; non.
	sub	#<'0-36>,a4	; oui. chiffre. a4 = [36:47](8).
	br	3$
2$:	mov	#33,a4		; alors c'est $. a4 = 33(8).

3$:	asl	a3
	asl	a3
	asl	a3
	add	a3,a4		; [PM] a4 = a4 + accum*10(8)
	asl	a3
	asl	a3		; [PM] a3 = accum*40(8)
	add	a4,a3		; a3 = a4 + accum*50(8)
	return
; ****** FICHIERS : FIC, INPUT, OUTPUT, CLOSE, EOF, RECORD.

; ---- FIC		used by INPUT, OUTPUT, and RECORD  [written by PM]

; assemble a file specification block (blki) based on the arguement list
; (the default extention must be loaded into blki3 by the caller)
; then do a directory lookup using the channel specified by the
; number in area (calling routine must do:  mov #chan+^O400,area)
; returns with the carry bit indicating if the file was found

FIC:	mov	#sysdev,blki	; use system device as default
	push	cdr(a1)		; save the rest of the arguments
	call	elist		; evaluate 1st arg if its a list
	mov	#blki1,a5
	call	radx50		; on radx50 le nom.1 dans blki1.
	mov	#blki2,a5
	call	radx50		; on radx50 le nom.2 dans blki2
	pop	a1		; recover rest of arguments
	jflst	a1,1$		; jump to 1$ if no more args.
	push	cdr(a1)		; save the rest of the arguments
	call	elist		; evaluate 2nd arg if its a list
	mov	#blki3,a5
	call	radx50		; on radx50 l'extension dans blki3.
	pop	a1
	jflst	a1,1$		; jump to 1$ if no more args.
	call	elist		; evaluate 3rd arg if its a list
	mov	#blki,a5
	call	radx50		; on radx50 l'extension dans blki3.
1$:	.dstatus #area+2,#blki	; le device existe-t-il ?
		; we avoid using area+0 because its holding channel for .lookup
	bcc	3$		; branch if device is legal
2$:	mov	#erdev,a1	; device error message
	jmp	errp
3$:	tst	area+6		; is the device loaded ?
	beq	2$		; branch if not
;	.lookup #area,,#blki	; do this explicitly to avoid moving
	mov	#area,r0	; anything into first word of area
	mov	#blki,2(r0)	; since the channel has allready been loaded
	EMT	^O375		; end of .lookup request
	return
erdev:	.asciz	/* device not loaded /		; [PM]
	.even
.page
; ***** (INPUT NAME EXTENTION DEVICE)   [FSUBR]
				; [modified extensively by PM]
input:
	jflst	a1,input2	; si retour au terminal.
	push	a1		; save param list
	mov	#extvli,blki3	; on colle l'extension par defaut.
	mov	#chani+^O400,area	; load channel number for lookup

	call	FIC		; assemble file specification

	bcs	false1		; jump if file not found

	call	iniitt		; initialiser buffer in.
	inc	dski		; indicateur entree disque a 1.
	clr	nblki		; init. no de bloc in.
	pop	a1		; sinon ramener le nom-fichier.
	return


; ----- (INPUT NIL)

input2:				; retour au terminal.
	call	iniitt
	clr	dski
	.close	#chani
	jmp	true		; et on ramene T.



;	----- elist	used by FIC	[written by PM]

elist:	mov	(a1),a1		; get car
	jflst	a1,elist3	; jump if the arg is not a list
	call	eval		; non-atomic args are evaluated
elist3:	add	#dplpn,a1	; a1 pointe sur la p-lengh du nom.
	movb	(a1)+,a2	; longueur du nom dans a2.
	return
.page
; ***** (OUTPUT NAME EXTENTION DEVICE)	[FSUBR]
;			[modified extensively by PM]
output:
	jflst	a1,outpu3	; cas (OUTPUT) ?
	push	a1		; save param list
	mov	#extvll,blki3	; extension VLL par defaut.
	mov	#chano+^O400,area	; load channel number for lookup

	call	FIC		; assemble file specification
	bcs	1$		; non. le creer.
				; oui. le detruire.
	.close	#chano		; faut le fermer d'abord. RT11 ...
	.delete	#area,#chano,#blki


1$:
	movb	#chano,enarea
	mov	#enarea,a1
	.enter			; creer.

	bcc	outpu4		; jump if enter was succesfull

false1:	tst	(p)+		; erreur ouverture du fichier. depiler
	jmp	false		; et ramener NIL.

outpu4:	call	outpu5		; initialiser buffer sortie TT. and DSK
	inc	dsko		; indicateur disque sortie a 1.
	clr	nblko		; initialiser no bloc out.
	pop	a1		; restituer nom.
wpop:	return
.page
; ----- (OUTPUT NIL)

outpu3:
	tst	oubpt		; buffer out TT vide ?
	beq	1$		; oui.
	mov	oubpt,a1	; non. forcer 0 a la fin.
	clrb	bufou(a1)
				; et transferer dans bfodk.
	call	trnfrt
1$:
	cmp	oubpk,#ebfodk	; buffer out DSK vide ?
	beq	2$		; oui.
	call	writew		; non. ecrire 256. mots de bfodk sur disque.
2$:
	clr	dsko
	.close	#chano
outpu5:	call	iniott		; reinitialiser les 2 buffers out.
	call	iniodk
	jmp	true		; et ramener T.

;	----- writew	[written by PM]

writew::
	mov	#ouarea,a1
writw2:	.writw
	bcc	wpop		; return if write ok
	movb	@#errbyt,a1	; get the error code
	push	a1
	mov	#erwmsg,a1
	jmp	errmp

erwmsg:	.asciz	/ ** Disk write error : /
	.even
	.page
; ***** (COP)		[SUBR 0]

;	this function was added by [PM]
;	copy input file to output device, then close input file

copy5:	inc	nblki		; [PM] increment input block number
	mov	#bufin,a4	; [PM] input buffer address
	mov	#bfodk,a5	; [PM] output buffer address
copy4:	mov	(a4)+,(a5)+	; [PM] move one word
	cmp	a5,#ebfodk	; [PM] end of buffer ?
	bne	copy4		; [PM] no, go transfer next word
	call	trnfr2		; [PM] send output buffer to output device

;	----- entry COP

cop:	mov	#inarea,a1
	.readw			; [PM] read a block of 256 words
	bcc	copy5		; [PM] branch if not end of file
	mov	#ebfodk,oubpk	; [PM] indicate we are at the end of buffer
	jmp	input2		; [PM] close the input file

; ***** (DEL)		[SUBR 0]
;
;	this function was added by [PM]
;	delete the current input file from the directory
;	note: the input file must be the last file opened for this to work.
;	i.e. there may not be an (OUTPUT ...) between the (INPUT ...) and the (DEL)

del:	call	input2		; first close the input file
	.delete	#area,#chani,#blki
	return
.page
; ***** (RECORD NAME EXTENTION DEVICE)   [FSUBR]
;			[modified extensively by PM]

record:
	.if	ne,recor

	jflst	a1,recor2	; on ferme ?
	push	a1		; save the param list
	mov	#extlog,blki3	; l'extension LOG.
	mov	#chanre+^O400,area	; load channel number for lookup

	call	FIC		; assemble file specification

	bcs	1$
	.close	#chanre
	.delete	#area,#chanre,#blki

1$:	movb	#chanre,enarea
	mov	#enarea,a1
	.enter
	bcs	false1
	call	iniott		; initialiser buffer sortie TT.
	call	inirdk		; initialiser buffer sortie RECORD.
	inc	flgrcd		; indicateur record a 1.
	clr	nblkre		; initialiser no de bloc record.
	pop	a1		; restituer nom.
	return


; ----- (RECORD NIL)
recor2:				; on ferme.
	cmp	rcdpt,#bfrdk	; buffer record vide ?
	beq	1$		; oui.
	mov	#rearea,a1	; non.
	call	writw2		; ecrire.
1$:
	clr	flgrcd
	.close	#chanre
	call	inirdk		; reinitialiser le buffer record.

	jmp	true		; et ramener T.
	.endc
; ****** TRUCS RT-11 DEPENDANTS : TYI, TYS, TYO

; ***** (TYI)   [SUBR 0]

tyi:
	.if	ne,rt11

	bis	#10000,@#jsw	; mode special : bit(12)[jsw] <- 1.
	.ttyin	a1		; lire le caractere en mode special.
	mov	a1,a2
	call	outb		; l'echoer (il faut en mode special).
	bic	#10000,@#jsw	; mode normal : bit(12)[jsw] <- 0.

	.endc

	return

; ***** (TYS)   [SUBR 0]

tys:
	.if	ne,rt11

	bis	#10100,@#jsw	; [PM] mettre a 1 le bit 12 du jsw. special mode.
				; mettre a 1 le bit 6 du jsw. no wait
	.ttinr			; lire dans a1 si ya qqchose a lire.
	bcc	1$		; jump if there was a character
	bic	#10100,@#jsw	; restore the job status word
	jmp	false		; no character, return nil
1$:
	bic	#10100,@#jsw	; [PM] razer bit 12 du jsw. normal mode.
				; razer bit 6 du jsw. wait.

	.endc

	return			; note that the character is not echoed


; ***** (TYO N)  [SUBR 1]  imprime sur TT le caractere de code ascii N.

				; N DOIT etre un INUM.
tyo:
	bic	#177600,a1	; garde les 7 bits low.
	mov	a1,a2
	jmp	outb		; [PM] impression immediate.
; ****** initialisations start, toplevel, reent et ITs

; ----- start

rstart: jmp	start1			; [JER] on rentre ici par un REENTER
					; clavier ( start address - 2 ) .

bfodk::					; the 256 word output buffer begins here
start:					; and overwrites initialization code

	mov	#bstak+2,p		; initialize stack

	.close	#chani			; dummy. pour charger le handler RT11.
					; il est en plus probablement resident.
	.trpset	#area,#trprtn		; [PM] intercept trap to 4 and 10
	.scca	#area,#cntlc		; [PM] intercept double control-C

; ----- positionnement de hlist.
;	%%%%%% a optimiser (en ayant des adresses absolues).
;	suffit de reculer et de masquer les 2 bits low.

	.settop	#-2			; [PM] request all available memory
					; [PM] r0 (a1) has result of settop
	tst	-(a1)			; descendre d'une adresse de mot.
	mov	a1,a2
	sub	#blist,a2
	bit	#3,a2			; a1 - #blist ? multiple de 4 ?
	beq	1$			; oui.
	tst	-(a1)			; descendre d'une adresse de mot.
1$:	mov	a1,hlist		; stocker.

; determine line frequency from RT11-monitor configuration word

	.if	ne,clock		; [PM]
	mov	@#sysptr,a1		; [PM] a1 points to monitor
	add	#config,a1		; [PM] a1 points to configuration word
	mov	(a1),a1			; [PM] a1 = configuration word
	bic	#-linfq-1,a1		; [PM] is it a 50 hz system?
	beq	2$			; [PM] branch if not
	dec	hz50			; [PM] indicate a 50 hz system
	.endc				; [PM]
	.page
; ----- autres initialisations.

2$:	clr	ringur			; raz ringur.
	mov	#69.,rmar		; taille max ligne. [PM]

	mov	#20.,prmdp		; profondeur max d'impression.
	mov	#1000.,prmln		; longueur max d'impression.

	mov	#latom,a1
	mov	a1,catol
	mov	a1,hdato
	mov	#catom,catoc
	mov	#nil,gcspk

	clr	a1
	clr	a2
	clr	a3
	call	garb			; garbage collecting initial.

	mov	#msgon,a1		; annonce initiale vlisp winning.
	call	outs

	.dstatus #area,#blki		; le device existe-t-il ?
	bcs	3$			; helas non.
	.lookup	#area,#chani,#blki	; VLISP.INI existe-t-il ?
	bcs	3$			; no.
	mov	#msgini,a1		; [PM] we found vlisp.ini
	br	4$			; [PM]
3$:
	clr	dski			; no VLISP.INI entree terminal.

	mov	#absini,a1
4$:	call	outs			; [PM]
	jmp	start1

absini:	.asciz	/ VLISP.INI is not there/<cr><lf>
	.even
msgon:	.ascii	/ VLISP is running (version=/
	.byte	version
	.ascii	/, options=/
	.byte	options
	.asciz	/)/<cr><lf>
	.even
msgini:	.asciz	/ VLISP.INI is now being read /<cr><lf>
	.even
.	=	bfodk+512.		; [PM]  give room for the output buffer
ebfodk	==	.			; chien de garde

start1:
	.if ne,rt11
	bis	#60000,@#jsw		; set bit 13 du jsw pour permettre reent
					; [JER] set bit 14 : pour les minuscules
	.endc
.page
reent::	mov	#bstak+2,p	; init pile
	clr	ipti
	clr	opti
	clr	xpldi		; reinit indicateur explode.
	clr	impli		; reinit indicateur implode.
	call	outpu5		; initialisation buffer sortie TT and DK
	call	iniitt		; initialisation buffer entree.
	clr	cntlc		; [PM] clear control-C flag.
	clr	lmar		; init marge gauche.
	clr	atevhk		; R.A.Z. evalhook.
	clr	pbind		; init pbind
	mov	#nil,gcspk	; init gc-muet.
	mov	#reemsg,a1	; Reenter message.
	call	outs

reen1:	mov	#nil,form	; efface la derniere forme.
	clr	rdprd		; raz le bn de ( pour p.p.

	clr	a3		; pour gc.
	mov	#attopl,a2	; adresse atome toplevel -> a2.
	mov	#nil,a1
	call	evalfu		; appel (TOPLEVEL NIL)
	br	reen1

mtrap:	.ascii	/Trap to /	; [PM] trap message
trpnum:	.word	0		; insert trap number here
	.ascii	/ from address ??????/	; replace ? with trap address
mtrape:	.byte	0		; end of trap message
reemsg: .ASCIZ	/ To exit type: (S)/<cr><lf>	; reenter message
	.EVEN

trprtn:				; [PM] routine for .trpset request
	mov	#030061,trpnum	; assume trap to 10
	bcs	1$		; jump if assumption correct
	mov	#032060,trpnum	; it was a trap to 4
1$:	MOV	(P),A1		; adresse du TRAP
	MOV	#mtrape,A2	; adresse zone recep adr trap
	MOV	#6,A3		; nb de caractere de l'adresse
2$:	MOV	A1,A4		; recup l'adresse
	BIC	#177770,A4	; isole le dernier digit
	ADD	#60,A4		; conversion ASCII
	MOVB	A4,-(A2)	; charge le caractere
	ASR	A1		; passe au digit suivant
	ASR	A1
	ASR	A1
	SOB	A3,2$		; ca roule
	.trpset	#area,#trprtn	; reset the trap routine
	mov	#mtrap,a1	; trap message
	mov	#errm,(p)	; error handler
	rti
.page
; ***** (TOPLEVEL)	[SUBR 0]

toplv:	call	readu		; (print (eval (read)))

	.if	ne,clock	; [PM]
	push	a1
	.gtim	#area,#otime
	pop	a1
	.endc			; [PM]

	call	eval

	.if	ne,clock	; [PM]
	push	a1
	.gtim	#area,#time
	pop	a1
	.endc			; [PM]

	tst	dski
	bge	1$
	return

1$:	mov	a1,it		; derniere valeur top-level dans cval(IT).
	mov	#'=,a2
	call	outb
	call	probj
	.page
; this section written by PM

	.if	ne,clock	; [PM]
	mov	time,a1		; on vide et on calcule et convertit le temps.
	mov	time2,a5
	sub	otime,a1	; soustraction double-longueur.
	sbc	a5
	sub	otime2,a5	; delta ticks dans a1-a5 : high low.

	mov	a1,a2		; get high order time
	bis	a5,a2		; is delta time = 0 ?
	beq	3$		; if yes, don't print time (clock didnt tick)

	mov	#60.,a2		; assume 60 hz.
	tst	hz50		; is it a 50 hz. system?
	beq	2$		; jump if not
	mov	#50.,a2		; 50 ticks/seconde.
2$:	call	dvd1		; a3 = seconds, a1 = remainder
	push	a1		; save the remainder
	call	pcrlf		; go to next line
	mov	#timsg,a1
	call	prstr		; print time used message
	mov	a3,a1		; get number of seconds
	call	probj		; print number of seconds
	mov	#'.,a1		; a1 = ascii for period
	call	prch		; print decimal point
	pop	a1		; get remainder
	mov	#6,a2		; divide by 6 for 60 hz system
	add	hz50,a2		; divide by 5 for 50 hz system
	call	dvd		; a3 = tenths of seconds, a1 = remainder
	push	a1		; save remainder
	mov	a3,a1		; get tenths of seconds
	add	#'0,a1		; convert to ascii
	call	prch		; print tenths of seconds
	pop	a1		; get remainder
	asl	a1		; compute offset in table for 60 hz system
	sub	hz50,a1		; modify the offset if it's a 50 hz system
	add	#sec.01,a1	; index into .01 seconds table
	movb	(a1),a1		; get hundreths of a second
	call	prch		; print hundreths of a second
	.endc

3$:	mov	it,a1		; "valeur" de (TOPLEVEL).
	jmp	pcrlf


	.if	ne,clock
timsg: .asciz	/ seconds used =/
	.even
sec.01:	.ascii	/00223456788*/
	.endc
	.page
;*****  (S at)  [SUBR 1]	[JER] pour sortir proprement.
;				[PM] changed from STOP to S
;	<at> peut etre une pseudo-chaine de commande qui est fournie a RT11

stop:
	JTNIL	A1,2$		; ya pas d'argument
	ADD	#dplpn,A1	; pointe sur le PLENGTH
	MOVB	(A1)+,A2	; recupere la taille de la commande.
	INC	A2		; [PM] send one extra byte (null)
	MOV	#510,A3		; adresse de rangement de la chaine
	MOV	A2,(A3)+	; range la taille de la commande.
1$:	MOVB	(A1)+,(A3)+	; range les caracteres
	SOB	A2,1$		; de la commande un a un.
	CLRB	-(A3)		; [PM] change last byte sent to a null
	BIS	#4000,@#JSW	; set bit 11 (Pass line to KMON) du JSW.
2$:
	.if	ne,recor
	tst	flgrcd		; est-on sous record ?
	beq	3$		; non.
	call	recor2		; oui. terminer le record
3$:
	.endc

	mov	#stopms,a1	; imprime Bye.
	call	outs
	CLR	A1		; pour le .SERROR
	.EXIT			; et voila!
STOPMS: .ASCIZ	/Bye/<cr><lf>
	.EVEN
; ****** zones nombres, atomes, listes.

; ----- zone nombres
;	pointeur de nombres libres dans freenb en memoire.

; [PM] use boundry feature of linker to advance to boundry of 32 or 64 bytes

	.psect	boxnum
bnum::	.blkb	npagnb*npage		; [PM]

hnum	==	.- <npage/16.>		; [PM] hnum is address of last number

; ----- zone atomes
;	noter que les p-names doivent etre en MAJUSCULES.

adato	=	0
.macro	makat	cval,fval,ftyp,ptyp,pn
adatox	=	.
	.nchr	lpn,pn
	.word	cval,nil,fval
	.byte	ftyp,ptyp
	.word	adato
	.ascii	<lpn>/pn/
	.even
adato	=	adatox
.endm


batom::
undef::					; UNDEF doit etre ici pour (OBLIST).
	makat	undef,0,0,0,UNDEF
nil::
	makat	nil,0,0,0,NIL
t::
	makat	t,0,0,0,T
lambda::
	makat	lambda,lambdp,12.,0,LAMBDA

subr0::	makat	subr0,0,0,0,0SUBR
subr1::	makat	subr1,0,0,0,1SUBR
subr2::	makat	subr2,0,0,0,2SUBR
subr3::	makat	subr3,0,0,0,3SUBR
nsubr::	makat	nsubr,0,0,0,NSUBR
fsubr::	makat	fsubr,0,0,0,FSUBR
expr::	makat	expr,0,0,0,EXPR
fexpr::	makat	fexpr,0,0,0,FEXPR
macro::	makat	macro,0,0,0,MACRO
.page
hcnst::
atquot::
	makat	atquot,car.p,12.,0,QUOTE

adatox	=	.
ipromt: .word	undef,nil,0
	.byte	0,0
	.word	adato
	.ascii	<2>/? /
	.even
adato	=	adatox

prompt::
	makat	ipromt,0,0,0,PROMPT

;	-----	begin type SUBR0

	makat	undef,rdmaq,2,0,<'>
atread::
	makat	undef,readu,2,0,READ
	makat	undef,cop,2,0,COP
	makat	undef,del,2,0,DEL
	makat	undef,peekch,2,0,PEEKCH
	makat	undef,readch,2,0,READCH
	makat	undef,teread,2,0,TEREAD
	makat	undef,oblist,2,0,OBLIST
	makat	undef,tyi,2,0,TYI
	makat	undef,tys,2,0,TYS
ateof::
	makat	undef,input2,2,0,EOF
	makat	undef,readli,2,0,READLINE
	makat	undef,praise,2,0,PRAISE
.page
;	-----	begin type SUBR1

	makat	undef,terpri,4,0,TERPRI
	makat	undef,car.p,4,0,CAR
	makat	undef,cdr.p,4,0,CDR
	makat	undef,ascii,4,0,ASCII
	makat	undef,cascii,4,0,CASCII
	makat	undef,implod,4,0,IMPLODE
	makat	undef,explod,4,0,EXPLODE
	makat	undef,eval,4,0,EVAL
	makat	undef,listp,4,0,LISTP
	makat	undef,numbp,4,0,NUMBP
	makat	undef,add1,4,0,ADD1
	makat	undef,add1,4,0,1+
	makat	undef,sub1,4,0,1-
	makat	undef,sub1,4,0,SUB1
	makat	undef,zerop,4,0,ZEROP

	makat	undef,eprogn,4,0,EPROGN
	makat	undef,null,4,0,NULL
	makat	undef,not,4,0,NOT
	makat	undef,atom,4,0,ATOM
prmdp::				; profondeur d'impression maximum (listes).
	makat	0,prlvl,4,0,PRINTLEVEL
prmln::				; longueur d'impression maximum (listes).
	makat	0,prlgn,4,0,PRINTLENGTH

	makat	undef,caar,4,0,CAAR
	makat	undef,cadr,4,0,CADR
	makat	undef,cdar,4,0,CDAR
	makat	undef,cddr,4,0,CDDR
	makat	undef,caaar,4,0,CAAAR
	makat	undef,caadr,4,0,CAADR
	makat	undef,cadar,4,0,CADAR
	makat	undef,caddr,4,0,CADDR
	makat	undef,cdaar,4,0,CDAAR
	makat	undef,cdadr,4,0,CDADR
	makat	undef,cddar,4,0,CDDAR
	makat	undef,cdddr,4,0,CDDDR
	makat	undef,boundp,4,0,BOUNDP
lmar::				; position de la marge gauche (defaut: 0).
	makat	0,lmargi,4,0,LMARGIN
rmar::				; position de la marge droite (defaut: 69).
	makat	0,rmargi,4,0,RMARGIN
.page
	makat	undef,length,4,0,LENGTH
	makat	undef,outpos,4,0,OUTPOS
	makat	undef,compl,4,0,COMPL
	makat	undef,copy,4,0,COPY
	makat	undef,last,4,0,LAST
	makat	undef,abs,4,0,ABS
	makat	undef,gc,4,0,GC
	makat	undef,evenp,4,0,EVENP
	makat	undef,oddp,4,0,ODDP
	makat	undef,stop,4,0,S	; [JER] 1SUBR	[PM]
	makat	undef,tyo,4,0,TYO
	makat	undef,plengt,4,0,PLENGTH
	makat	undef,evlis,4,0,EVLIS
	makat	undef,litato,4,0,LITATOM

; .........
	.if	ne,fis

	makat	undef,float,4,0,FLOAT
	makat	undef,fix,4,0,FIX	; [PM] changed from subr2 to subr1

;	-----	begin type SUBR2

	makat	undef,fplus,6,0,<$+>
	makat	undef,fdiff,6,0,<$->
	makat	undef,ftimes,6,0,<$*>
adatox	=	.
	.word	undef,nil,fquo
	.byte	6,0
	.word	adato
	.byte	2,44,57			; code ascii du "$/".
adato	=	adatox
	.even
	.endc
; .........
	.page
atcons::
	makat	undef,cons,6,0,CONS
	makat	undef,rplaca,6,0,RPLACA
	makat	undef,rplacd,6,0,RPLACD
	makat	undef,rplacb,6,0,RPLACB
	makat	undef,typech,6,0,TYPECH
	makat	undef,princh,6,0,PRINCH
	makat	undef,eq,6,0,EQ
	makat	undef,eq,6,0,<=>
	makat	undef,neq,6,0,NEQ
	makat	undef,revers,6,0,REVERSE
	makat	undef,frever,6,0,FREVERSE
	makat	undef,equal,6,0,EQUAL
	makat	undef,nequal,6,0,NEQUAL
	makat	undef,memq,6,0,MEMQ
	makat	undef,member,6,0,MEMBER
	makat	undef,apply,6,0,APPLY
	makat	undef,lt,6,0,LT
adatox	=	.
	.word	undef,nil,lt
	.byte	6,0
	.word	adato
	.byte	1,74			; code ascii du "<".
adato	=	adatox
	makat	undef,gt,6,0,GT
adatox	=	.
	.word	undef,nil,gt
	.byte	6,0
	.word	adato
	.byte	1,76			; code ascii du ">".
adato	=	adatox
	makat	undef,le,6,0,LE
	makat	undef,ge,6,0,GE
	makat	undef,differ,6,0,-
	makat	undef,outbuf,6,0,OUTBUF
	makat	undef,logxor,6,0,LOGXOR
	makat	undef,logor,6,0,LOGOR
	makat	undef,logand,6,0,LOGAND
	makat	undef,lsh,6,0,LSH
	makat	undef,quo,6,0,QUO
.page
adatox	=	.
	.word	undef,nil,quo
	.byte	6,0
	.word	adato
	.byte	1,57			; code ascii du "/".
adato	=	adatox

	makat	undef,rem,6,0,REM

adatox	=	.
	.word	undef,nil,rem
	.byte	6,0
	.word	adato
	.byte	1,134			; code ascii du "\".
adato	=	adatox

	makat	undef,nconc,6,0,NCONC
	makat	undef,nconc1,6,0,NCONC1
	makat	undef,synony,6,0,SYNONYM
	makat	undef,get,6,0,GET
	makat	undef,rempro,6,0,REMPROP
	makat	undef,appen1,6,0,APPEND1
	makat	undef,append,6,0,APPEND
	makat	undef,nth,6,0,NTH
	makat	undef,set,6,0,SET
	makat	undef,dcons,6,0,DCONS

	makat	undef,mapc,6,0,MAPC
	makat	undef,map,6,0,MAP

	makat	undef,mapcar,6,0,MAPCAR
	makat	undef,maplis,6,0,MAPLIST
	makat	undef,mapcon,6,0,MAPCONC


	makat	undef,fval,6,0,FVAL

	makat	undef,ptype,6,0,PTYPE
	makat	undef,ftype,6,0,FTYPE

	makat	undef,assq,6,0,ASSQ
	makat	undef,assoc,6,0,ASSOC
	makat	undef,delq,6,0,DELQ

	makat	undef,delete,6,0,DELETE
atevhk::
	makat	0,evalhk,6,0,EVALHOOK
	makat	undef,popj,6,0,MULTIPLE
	makat	undef,alphle,6,0,ALPHALE
	makat	undef,mul32,6,0,MUL32		; [PM]
.page
;	-----	begin type SUBR3

	makat	undef,memory,8.,0,MEMORY
	makat	undef,put,8.,0,PUT
	makat	undef,addpro,8.,0,ADDPROP
	makat	undef,subst,8.,0,SUBST
	makat	undef,scale,8.,0,SCALE

;	-----	begin type SUBRN

	makat	undef,applyn,10.,0,APPLYN


;	-----	begin type FSUBR

atmcns::
	makat	undef,mcons,12.,0,MCONS
atlist::
	makat	undef,list,12.,0,LIST

	makat	undef,de,12.,0,DE
	makat	undef,df,12.,0,DF
	makat	undef,dm,12.,0,DM

	makat	undef,if,12.,0,IF
	makat	undef,ifn,12.,0,IFN
	makat	undef,cond,12.,0,COND

	makat	undef,progn,12.,0,PROGN
	makat	undef,prin,12.,0,PRIN
atprnt::
opti::				; indicateur status print.
				; bit 0 = 0 impression debute par un espace.
				;	= 1 non
				; bit 1 = 0 si on ne met pas les / .
				; bit 2 = 0 pas de "..." en sortie chaines.

	makat	0,print,12.,0,PRINT
.page
	makat	undef,setq,12.,0,SETQ
	makat	undef,setqq,12.,0,SETQQ
	makat	undef,nextl,12.,0,NEXTL
	makat	undef,newl,12.,0,NEWL
	makat	undef,status,12.,0,STATUS
	makat	undef,self,12.,0,SELF
	makat	undef,exit,12.,0,EXIT
	makat	undef,where,12.,0,WHERE
atescp::
	makat	undef,escape,12.,0,ESCAPE
	makat	undef,and,12.,0,AND
	makat	undef,or,12.,0,OR
	makat	undef,while,12.,0,WHILE
	makat	undef,until,12.,0,UNTIL
	makat	undef,prog1,12.,0,PROG1
	makat	undef,dmc,12.,0,DMC

atastr::
	makat	undef,times,12.,0,*
	makat	undef,plus,12.,0,+
	makat	undef,exch.p,12.,0,EXCH
	makat	undef,incr,12.,0,INCR
	makat	undef,decr,12.,0,DECR
	makat	undef,seltq,12.,0,SELECTQ
	makat	undef,input,12.,0,INPUT
	makat	undef,output,12.,0,OUTPUT
	makat	undef,record,12.,0,RECORD
	makat	undef,msetq,12.,0,MSETQ
.page
	.IF	NE,COLORX	; [JER]
ATVISI:: MAKAT	UNDEF,VISINI,12.,0,VISINI
ATVISP:: MAKAT	UNDEF,VISPOT,12.,0,VISPOT
ATVISS:: MAKAT	UNDEF,VISEGM,12.,0,VISEGM
ATVISM:: MAKAT	UNDEF,VISMEM,12.,0,VISMEM
	.ENDC

carry::	makat	0,0,0,0,CARRY			; [PM] for +
ibase::
	makat	8.,0,0,0,IBASE
obase::
	makat	10.,0,0,0,OBASE
it:
	makat	nil,0,0,0,IT
latom:
attopl: makat	undef,toplv,2,0,TOPLEVEL

;	--- free atom space follows ---			[PM]
catom:	.blkw	atsize
hatom	==	.-2				; last word in atom space [PM]

; ----- zone listes

blist	==	.				; beginning of list space

	.end	start				; ****** la-fin ******
