.TITLE VL5 .psect VL5 ; stored on: VL5.MAC ; last revision: 16-APR-82 ; MODULE PAGE CONTENTS ; VL5 10 ****** fonctions de controle. ; 13 ****** predicats, true, false. ; 20 ****** recherches. ; 25 ****** creation d'objets. ; 30 ****** modifications d'objets. ; 34 ****** fonctions sur p-listes. xx1 = version xx2 = options xx3 = eis xx4 = fis xx5 = clock xx6 = i11.04 xx7 = recor .globl atescp,batom,blist,bnum .globl catol,cons,erfs,erplc .globl eval,evca1,expr,fexpr .globl fsubr,hcnst,hnum,hstak .globl macro,nil,nsubr,prgna3 .globl progn,qcons,savpil .globl subr0,subr1,subr2,subr3 .globl t,tem0,undef,valnb,valnb2,xcons .page ; ****** fonctions de controle. ; ***** (IF S . L) [FSUBR] if:: push a1 call evca1 ; evaluer le predicat. pop a2 mov cdr(a2),a2 jfnil a1,then ; [PM] mov cdr(a2),a3 jmp prgna3 ; else clauses. then: mov (a2),a1 ; [PM] then clause. jmp eval ; ***** (IFN S . L) [FSUBR] ifn:: push a1 call evca1 ; evaluer le predicat. pop a2 mov cdr(a2),a2 jtnil a1,then ; [PM] mov cdr(a2),a3 jmp prgna3 ; else clauses. ; ***** (COND . LC) [FSUBR] cond:: mov a1,a2 cond1: jtlst a2,1$ 2$: return ; ya plus de clauses. 1$: mov (a2)+,a1 ; a1 = clause suivante. push (a2) ; sauve le reste des clauses. push cdr(a1) call evca1 ; evalue le predicat. pop a3 ; a3 = le corps de la clause. pop a2 ; a2 = le reste des clauses. jtnil a1,cond1 ; le predicat ramene nil. jtnil a3,2$ ; en cas de clause vide. jmp prgna3 ; evalue le corps de la clause. .page ; ***** (OR . L) [FSUBR] tail-recursif. or1: push a2 call evca1 jfnil a1,pret ; depile et retourne. pop a1 ; ----- entry or. or:: mov cdr(a1),a2 jtlst a2,or1 jmp evca1 ; le dernier element. ; ***** (AND . L) [FSUBR] and2: push a2 call evca1 jtnil a1,pret ; depile et retourne. pop a1 and1: mov cdr(a1),a2 jtlst a2,and2 jmp evca1 ; le dernier element. ; ----- entry and. and:: jtlst a1,and1 jmp true ; (AND) -> T ; ***** (WHILE . L) [FSUBR] while:: push a1 ; empile toute l'expression. br while2 while1: mov (p),a1 ; recupere l'expression entiere. mov cdr(a1),a1 ; le corps. call progn while2: mov (p),a1 call evca1 ; value le test. jfnil a1,while1 ; faut reevaluer le corps. ; pret doit suivre. ; ----- pret : depile et retourne. pret: tst (p)+ return .page ; ***** (UNTIL . L) [FSUBR] until:: push a1 ; empile toute l'expression. br until2 until1: mov (p),a1 ; recupere l'expression entiere. mov cdr(a1),a1 ; le corps. call progn until2: mov (p),a1 call evca1 ; value le test. jtnil a1,until1 ; faut reevaluer le corps. ; pret doit suivre. br pret ; ***** (SELECTQ E C1 ... CN L) [FSUBR] seltq:: push #prgna3 ; hack derec final. push cdr(a1) ; sauver (C1 ... CN L). call evca1 ; evaluer E. mov (p),a4 ; a4 = (C1 ... CN L). mov a1,(p) ; pile = E*:PRGNA3: ... br seltq2 seltq1: mov (p),a1 ; a1 = E*, A3 = Ci. push a4 ; empiler reste des clauses. mov (a3)+,a2 ; a2 = car Ci. push (a3) ; sauve reste de Ci. push #2$ ; hack. jtlst a2,1$ br eq 1$: jmp member 2$: pop a3 ; recuperer reste-de-Ci. pop a4 ; recuperer clauses. jfnil a1,seltq3 ; si OK. seltq2: mov (a4)+,a3 ; a3 = Ci. mov (a4),a4 ; a4 = (Ci+1 ... ) jtlst a4,seltq1 ; si Ci non-derniere. seltq3: tst (p)+ ; ignorer E*. return ; vers PRGNA3. ; ****** predicats, true, false ; ***** (NEQ S1 S2) [subr 2] neq est aussi polymorphique (gasp!). neq:: call eq ; null doit suivre. ; ***** (NULL S) [SUBR 1] ; ***** (NOT S) [SUBR 1] null:: not:: jtnil a1,true br false ; ***** (ATOM S) [SUBR 1] atom:: jflst a1,true br false ; ***** (LISTP S) [SUBR 1] listp:: jtlst a1,true br false ; ***** (NUMBP S) [SUBR 1] numbp:: jtnum a1,true br false ; ***** (EQ S1 S2) [SUBR 2] eq est polymorphique (sigh!) . eq:: cmp a1,a2 beq true cmp a1,#hnum bhi false cmp a2,#hnum bhi false cmp a1,#bnum blo false cmp a2,#bnum blo false cmp (a1),(a2) bne false ; ......... .if ne,fis ; [PM] cmp 2(a1),2(a2) bne false .endc ; [PM] ; ......... br true .page ; ***** (NEQUAL S1 S2) [SUBR 2] nequal:: push #not ; equal doit suivre. ; ***** (EQUAL S1 S2) [SUBR 2] equal:: mov p,savpil ; sauve le sp pour les retours rapides. call equal2 br true equal1: jflst a2,equal3 mov (a1)+,a4 ; car a1 dans a4. mov (a2)+,a5 ; car a2 dans a5. ckstk push (a1) ; sauve cdr a1. push (a2) ; sauve cdr a2. mov a4,a1 mov a5,a2 call equal2 ; recursion sur les car. pop a2 pop a1 equal2: jtlst a1,equal1 ; iteration sur les cdrs. call eq jtnil a1,equal3 return ; ya eu 1 tres beau bug : lorsque les ; 3 instructions precedentes etaient ; remplacees par un "br eq". equal3: mov savpil,p ; ramene la pile a sa juste valeur. br false ; retour faux. .page ; ***** (BOUNDP A) [SUBR 1] boundp:: cmp (a1),#undef bne true br false ; ----- true, false true:: mov #t,a1 return false:: mov #nil,a1 return ; ***** (GT N1 N2) [SUBR 2] ; noter que : ; (gt/ge/lt/le n) == (gt/ge/lt/le n 0) gt:: exch a1,a2 ; (gt a b) == (lt b a) ; ***** (LT N1 N2) [SUBR 2] ; valnb2 : a1 = valnb(a1), a4 = valnb(a2). ; cette bizarrerie permet de garantir que ; garb ne trouvera pas dans a2 ; des adresses de CDR. lt:: jfnil a1,1$ clr a1 ; cas (fonc nil n) 1$: jfnil a2,2$ clr a2 ; cas (fonc n nil) 2$: ; ......... .if eq,fis call valnb2 cmp a1,a4 blt true br false .endc ; ......... .page ; ......... .if ne,fis clr a4 cmp a1,#bnum blo 3$ mov 2(a1),a4 mov (a1),a1 3$: clr a5 cmp a2,#bnum blo 4$ mov 2(a2),a5 mov (a2),a2 4$: cmp a1,a2 blt true bgt false cmp a4,a5 blt true br false .endc ; ......... .page ; ***** (GE N1 N2) [SUBR 2] ge:: exch a1,a2 ; (ge a b) == (ge b a) ; ***** (LE N1 N2) [SUBR 2) le:: jfnil a1,1$ clr a1 ; cas (fonc nil n) 1$: jfnil a2,2$ clr a2 ; cas (fonc n nil) 2$: ; ......... .if eq,fis call valnb2 cmp a1,a4 ble true br false .endc ; ......... ; ......... .if ne,fis clr a4 cmp a1,#bnum blo 3$ mov 2(a1),a4 mov (a1),a1 3$: clr a5 cmp a2,#bnum blo 4$ mov 2(a2),a5 mov (a2),a2 4$: cmp a1,a2 blt true bgt false cmp a4,a5 bgt false br true .endc ; ......... .page ; ***** (ZEROP N) [SUBR 1] zerop:: call valnb tst a1 beq 1$ br false 1$: return ; OK puisque 0 est un INUM !!! ; ***** (EVENP N) [SUBR 1] evenp:: mov a1,a2 call valnb bit #1,a1 bne false a2popj ; ***** (ODDP N) [SUBR 1] oddp:: mov a1,a2 call valnb bit #1,a1 beq false a2popj .page ; ***** (LITATOM E) [SUBR 1] litato:: jtnum a1,false jtlst a1,false br true ; ***** (ALPHALE A1 A2) [SUBR 2] alphle:: add #dplpn,a1 add #dplpn,a2 mov (a2)+,a5 mov (a1)+,a4 ; les longueurs respectives. br 2$ 1$: cmpb (a1)+,(a2)+ bgt false ; a1 > a2. KO. blt true ; a1 < a2. OK. dec a5 dec a4 2$: ble true tst a5 bgt 1$ br false ; ****** recherches ; ***** (C...R S) [SUBR 1] cdddr:: tst (a1)+ cddar:: mov (a1),a1 cddr:: tst (a1)+ cdar:: mov (a1),a1 cdr.p:: tst (a1)+ car.p:: mov (a1),a1 return caddr:: tst (a1)+ cadar:: mov (a1),a1 cadr:: tst (a1)+ caar:: mov @(a1),a1 return cdadr:: tst (a1)+ cdaar:: mov (a1),a1 br cdar caadr:: tst (a1)+ caaar:: mov (a1),a1 mov @(a1),a1 return ; ***** (MEMQ A L) [SUBR 2] memq:: push #eq br memb2 .page ; ***** (MEMBER E L) [SUBR 2] member:: push #equal memb2: mov a2,a3 push a1 br 2$ 1$: mov (a3),a1 ; a1 = (CAR L) mov (p),a2 ; a2 = E push a3 push 4(p) ; empiler eq ou equal. call @(p)+ ; coroutine. pop a3 jfnil a1,3$ mov cdr(a3),a3 2$: jtlst a3,1$ ; la liste est vide ? 3$: cmp (p)+,(p)+ ; depiler. mov a3,a1 ; ramene le dernier cdr. return ; ***** (FVAL A [E]) [SUBR 2] get/set la f-val de l'atome A. fval:: jtnum a1,fval1 ; l'argument doit etre jtlst a1,fval1 ; un atome litteral. jtnil a2,1$ ; en modification ? mov a2,dpfval(a1) ; oui. forcer nouvelle f-val. 1$: mov dpfval(a1),a1 ; prendre la f-val. return fval1: jmp false .page ; ***** (FTYPE A [E]) [SUBR 2] get/set le f-type de l'atome A. ftype:: jtnum a1,fval1 ; A n'est pas jtlst a1,fval1 ; un atome litteral. jtnil a2,ftype1 ; modification ? mov #etypft,a4 ; oui. br 2$ 1$: cmp -(a4),-(a4) ; a4 <- a4 - 2. 2$: mov (a4),a5 jtnil a5,3$ ; fini c'est nil. cmp a2,a5 ; comparer a E. bne 1$ ; c'est pas encore le bon truc. 3$: ; trouve ou nil. calculer le type interne. sub #typft,a4 ; a4 = [0:20.] movb a4,dpftyp(a1) ; forcer nouveau f-type. ftype1: movb dpftyp(a1),a2 ; a2 = [0:20.] mov typft(a2),a1 ; recuperer l'atome correspondant. return ; et bye. ; ----- table typft utilisee par ftype. typft: .word nil ; code 0 : no-fonction. .word subr0 ; code 2 .word subr1 ; code 4 .word subr2 ; code 6 .word subr3 ; code 8. .word nsubr ; code 10. .word fsubr ; code 12. .word expr ; code 14. .word fexpr ; code 16. .word macro ; code 18. etypft: .word atescp ; code 20. .page ; ***** (PTYPE A [N]) [SUBR 2] get/set le p-type de l'atome A. ptype:: jtnum a1,fval1 ; A n'est pas jtlst a1,fval1 ; un atome litteral. mov a1,a3 ; atome dans a3. mov a2,a1 ; [N] dans a1. jtnil a1,1$ call valnb ; a1 = valeur binaire nouveau p-type. bic #177400,a1 ; on ne garde que les 8 low bits. movb a1,dpptyp(a3) ; forcer nouveau p-type. 1$: movb dpptyp(a3),a1 ; attraper p-type. bic #177400,a1 ; ne garder que les 8 low bits. ; jmp cranb ; et ramener le nombre ad hoc. return ; [PM] previous line not necessary ; ***** (PLENGTH A) [SUBR 1] plengt:: movb dplpn(a1),a1 ; c'est (vraisemblablement) un inum. return ; on le ramene a sa grand-mere. ; ***** (NTH N L) [SUBR 2] nth:: call valnb br 1$ 2$: mov cdr(a2),a2 1$: sob a1,2$ a2popj .page ; ***** (LAST L) [SUBR 1] last1: mov a2,a1 ; ----- entry last last:: mov cdr(a1),a2 jtlst a2,last1 return ; ***** (ASSQ AT L) [SUBR 2] assq:: push #eq br asso2 ; ***** (ASSOC E L) [SUBR 2] assoc:: push #equal asso2: push a1 br 2$ 1$: mov (p),a1 push a2 mov @(a2),a2 push 4(p) ; empiler le eq ou le equal. call @(p)+ ; coroutine. pop a2 jfnil a1,3$ mov cdr(a2),a2 2$: jtlst a2,1$ 3$: mov (a2),a1 cmp (p)+,(p)+ return ; ****** creation d'objets. ; ***** (EVLIS L) [SUBR 1] evlis:: jflst a1,evlis1 ; R.A.F. bye. push cdr(a1) ; preserver reste. call evca1 ; evalue l'element suivant. xtopst a1,via,a2 ; empile element evalue. ; et recupere le reste. call evlis ; pile = En*:etiq: ... :E2*:etiq:E1*:retour:... evlis2: ; used by mcons, copy pop a2 ; recuperer l'element evalue. jmp xcons evlis1: return ; used by mcons. ; ***** (LIST . L) [FSUBR] list == evlis ; ***** (MCONS . L) [FSUBR] ; %%%%%% revoir, optimiser. mcons:: jflst a1,evlis1 ; bye T.D.S. si a1 non-liste. br mcons0 mcons2: push cdr(a1) ; sauver reste. call evca1 ; evaluer element. xtopst a1,via,a5 push #evlis2 ; i.e. pop a2 ; jmp xcons. mcons0: jtlst a1,mcons2 ; test interne. tst (p)+ ; ignorer adresse de retour. pop a1 ; attraper le En* dans a1. return ; ***** (DCONS E L) [SUBR 2] dcons:: consl 0,#nil,a3 ; last a3 = (0 . nil) push a3 ; empiler hook br 2$ 1$: consl a1,(a2)+,-(p) ; empiler (cons E (car a2)). mov (a2),a2 ; a2 = (cdr a2). consl (p)+,#nil,cdr(a3) ; forcer ((cons ...) . nil) dans cdr.last. mov a4,a3 ; nouveau last. 2$: jtlst a2,1$ pop a1 ; recuperer hook. jmp cdr.p ; et ramener son cdr. .page ; ***** (OBLIST) [SUBR 0] oblist:: mov #nil,a1 ; creation de liste inversee. mov catol,a3 1$: consl a3,a1,a1 mov dpnexa(a3),a3 bne 1$ br cdr.pA ; [PM] pour eviter undef. ; ***** (REVERSE L1 L2) [SUBR 2] rev1: consl (a1)+,a2,a2 ; a2 = (cons (car a1) a2). mov (a1),a1 ; a1 = (cdr a1). ; ----- entry reverse. revers:: jtlst a1,rev1 a2popj ; ***** (LENGTH L) [SUBR 1] length:: mov a1,a4 clr a1 br 2$ 1$: mov cdr(a4),a4 inc a1 2$: jtlst a4,1$ ; jmp cranb ; [PM] this line not necessary return ; [PM] .page ; ***** (APPEND1 L1 S) [SUBR 2] appen1:: consl a2,#nil,a2 ; append doit suivre. ; ***** (APPEND L1 L2) [SUBR 2] append:: consl 0,#nil,a3 ; last a3 = (0 . nil) push a3 ; empiler hook. br 2$ 1$: consl (a1)+,#nil,cdr(a3) ; a4 = cdr(a3) = (cons (car a1) nil). mov (a1),a1 ; a1 = (cdr a1). mov a4,a3 ; new last. 2$: jtlst a1,1$ mov a2,cdr(a3) ; forcer a2. pop a1 ; recuperer hook. cdr.pA: jmp cdr.p ; et ramener son cdr. ; ***** (COPY S) [SUBR 1] copy:: jflst a1,subst3 push cdr(a1) mov (a1),a1 call copy ; a1 = (COPY (car S)) xtopst a1,via,a5 push #evlis2 ; i.e. pop a2 ; jmp xcons. br copy ; call copy ; a1 = (COPY (cdr S)) ; pop a2 ; jmp xcons .page ; ***** (SUBST NEW OLD EXP) [SUBR 3] subst:: push a1 ; sauver new. push a2 ; sauver old. mov p,tem0 ; pile = old:new:suite mov a3,a1 ; a1 = exp, a2 = old. call subst1 cmp (p)+,(p)+ ; depiler 2 fois. subst3: return ; used by COPY. subst0: mov @tem0,a2 ; a1 = exp, a2 = old. subst1: push a1 ; a1 = exp, a2 = old. call equal pop a2 ; a2 = exp. jtnil a1,subst2 ; si (nequal exp old). mov tem0,a5 ; cas (equal exp old), on ramene new. mov 2(a5),a1 ; a1 = new. return subst2: jtlst a2,1$ ; a2 = exp atome ? a2popj ; oui. on le ramene. 1$: mov (a2)+,a3 ; a3 = (car exp) mov (a2),a1 ; a1 = (cdr exp) push a3 ; sauver (car exp). call subst0 ; (subst ... (cdr exp)) xtopst a1,via,a5 call subst0 ; (subst ... (car exp)) pop a2 jmp cons .page ; ***** (DELQ AT L) [SUBR 2] delq:: push #eq br delet2 ; ***** (DELETE E L) [SUBR 2] delete:: push #equal delet2: push a1 ; empiler AT/E consl 0,#nil,a3 ; last a3 = (0 . nil) push a3 ; empiler hook. br 3$ 1$: ; pile = hook:AT/E:predicat:reste... mov (a2)+,a1 push (a2) ; empiler cdr L. push a1 ; empiler car L = a1. mov 6(p),a2 ; a2 = AT/E push 8.(p) ; empiler EQ ou EQUAL. call @(p)+ ; coroutine. pop a2 ; recuperer car L. jfnil a1,2$ ; si AT/E eq(ual) car L. consl a2,#nil,cdr(a3) ; a4 = cdr(a3) = (cons (car L) nil). mov a4,a3 ; new last 2$: pop a2 ; recuperer cdr L. 3$: jtlst a2,1$ ; encore ? pop a1 ; recuperer le hook. cmp (p)+,(p)+ ; ignorer AT/E et predicat. jmp cdr.p ; ****** modifications d'objets. ; ***** (RPLACA S1 S2) [SUBR 2] rplaca:: cmp a1,#hcnst ; [PM] is it restricted from modification? blos erplc1 ; [PM] jump if yes mov a2,(a1) return ; ***** (RPLACD S1 S2) [SUBR 2] rplacd:: cmp a1,#hcnst ; [PM] is it restricted from modification? blos erplc1 ; [PM] jump if yes mov a2,cdr(a1) return ; ***** (RPLACB S1 S2) [SUBR 2] rplacb:: cmp a1,#hcnst ; [PM] is it restricted from modification? blos erplc1 ; [PM] jump if yes mov (a2)+,(a1)+ mov (a2),(a1) mov -(a1),a2 ; pour gc. recule a1. neutralise a2. return ; ***** (SET S1 S2) [SUBR 2] set:: cmp a1,#hcnst ; [PM] is it restricted from modification? bhi .+6 ; [PM] no, its ok erplc1: jmp erplc ; [PM] tell user, cant modify a constant mov a2,(a1) a2popj .page ; ***** (SETQ V1 E1 ... VN EN) [FSUBR] setq1: mov a2,a1 ; ----- entry setq setq:: push (a1)+ ; sauve le nom de la variable varI mov (a1),a1 ; a1 = (valI varI+1 valI+1 ...) push cdr(a1) ; sauve le reste call evca1 ; et evalue la val. pop a2 ; recupere le reste de la liste. mov a1,@(p)+ ; forcer c-val dans nom de la variable. jtlst a2,setq1 ; il reste encore des couples. return ; non. ramene la derniere valeur. ; ***** (SETQQ V1 E1 ... VN EN) [FSUBR] setqq:: uncns ; a2 = variable suivante, a1 = reste. mov (a1)+,a3 ; a3 = valeur suivante. mov a3,(a2) mov (a1),a1 jtlst a1,setqq mov a3,a1 return .page ; ***** (MSETQ V1 V2 E) [FSUBR] msetq:: ; uncns ; a2 = V1, a1 = (V2 E). ; push a2 ; uncns ; a2 = V2, a1 = (E). ; push a2 ; call evca1 push (a1)+ ; sauver V1. mov (a1),a1 ; a1 = (V2 E). push (a1)+ ; sauver V2. mov @(a1),a1 ; a1 = E call eval mov a2,@(p)+ ; affecter V2. mov a1,@(p)+ ; affecter V1. return ; ***** (NEXTL V) [FSUBR] nextl:: mov (a1),a2 ; a2 = la-variable. mov (a2),a4 ; a4 = sa-valeur mov (a4)+,a1 mov (a4),(a2) return ; ***** (NEWL AT E) [FSUBR] newl:: push (a1)+ ; sauve le nom de l'atome. mov (a1),a1 ; a1 = (E) call evca1 ; evalue l'expression. valeur dans a1. mov @(p),a2 ; valeur de la variable dans a2. call cons ; fabrique la nouvelle valeur. mov a1,@(p)+ ; qui est rangee dans la cval. return .page ; ***** (FREVERSE L1 L2) [SUBR 2] frev1: mov cdr(a1),a3 mov a2,cdr(a1) mov a1,a2 mov a3,a1 ; ----- entry freverse. frever:: jtlst a1,frev1 frev2: a2popj ; ***** (NCONC1 L1 AT) [SUBR 2] nconc1:: consl a2,#nil,a2 ; nconc doit suivre. ; ***** (NCONC L1 L2) [SUBR 2] nconc:: jflst a1,frev2 ; si a1 non-liste. push a1 ; preserver pointeur sur debut de a1. br 3$ ; et rouler. 2$: mov a4,a1 ; avancer dans la liste. 3$: mov cdr(a1),a4 ; dernier doublet ? jtlst a4,2$ ; non. mov a2,cdr(a1) ; oui. forcer son cdr. pop a1 ; et ramener le debut. return ; ***** (EXCH AT1 AT2) [FSUBR] echange de variables. exch.p:: mov (a1)+,a4 ; a4 = v1 mov @(a1),a5 ; a5 = v2 mov (a4),a1 mov (a5),(a4) mov a1,(a5) return ; ****** fonctions sur p-listes. ; ***** (ADDPROP AT VAL INDIC) [SUBR 3] addpro:: consl a2,cdr(a1),a2 ; a2 = (VAL . oldplist) consl a3,a2,cdr(a1) ; cdr(a1) = (INDIC VAL . oldplist) return ; ----- gett a1 = un atome, a2 = un indicateur. ; ramene : si non trouve -> a4 = nil. ; si trouve -> a4 = (oldval ...) ; a5 = (x indic oldval ...) gett: mov a1,a5 push a1 ; sauver atome. mov a1,a4 br 2$ ; aller attraper la p-liste de l'atome. ; invariant : a5 = (x indic oldval ...) ; a4 = (indic oldval ...) 1$: mov (a4),a1 ; a1 = indic call eq mov cdr(a4),a4 ; a4 = (oldval ...) jfnil a1,3$ ; si a2 = indic mov a4,a5 ; a5 = (x.oldval indic val ...) 2$: mov cdr(a4),a4 ; a4 = (indic val ...) jtlst a4,1$ ; a5 = (x indic val ...) 3$: pop a1 ; restaurer atome. return .page ; ***** (GET AT INDIC) [SUBR 2] get:: call gett mov (a4),a1 ; tant pis si a4 = nil. return ; ***** (PUT AT VAL INDIC) [SUBR 3] put:: push a2 ; sauver VAL. mov a3,a2 ; indic dans a2 pour gett. call gett pop a2 ; restaurer VAL jtnil a4,addpro ; en tete si INDIC n'existe pas encore. mov a2,(a4) ; coller nouvelle VAL sous INDIC. return ; et bye. ; ***** (REMPROP AT INDIC) [SUBR 2] rempro:: call gett jtnil a4,rempr2 ; si INDIC absent. mov cdr(a4),cdr(a5) ; enlever (INDIC VAL). rempr2: return .end ; ****** END OF VL5 ******