LEX    'VECTLEX'
* (c) Copyright PPC Paris 1986

       TITLE  Vecteurs manipulations
*      Jean-Jacques DHENIN  (SIG#5 P#177)
*               43 36 12 05
*
*      1Ére partie  : TPOURC    29/12/85
*
**********************************************
*
id     EQU    #5C
t      EQU    100

Vcfg0  ID     id
       MSG    0
       POLL   pvect
       ENTRY  Sum
       CHAR   #F
       ENTRY  Pro
       CHAR   #D
       ENTRY  Copy
       CHAR   #D
       ENTRY  Tri
       CHAR   #D
       ENTRY  Plus
       CHAR   #D
       KEY    'VSUM'
       TOKEN  t
       KEY    'VMULT'
       TOKEN  1+t
       KEY    'VCOPY'
       TOKEN  2+t
       KEY    'VSORT'
       TOKEN  3+t
       KEY    'VADD'
       TOKEN  4+t
       ENDTXT

=A-MULT EQU   #1B349
=AD2-12 EQU   #0C35F
=AD2-15 EQU   #0C363
=ARGERR EQU   #0BF19
=ARYDC  EQU   #05178
=ARYELM EQU   #0B5A7
=ARYSIZ EQU   #0B61B
=AVMEMS EQU   #2F594
=COLLAP EQU   #091FB
=COMCK  EQU   #036CD
=CSLC5  EQU   #1B435
=CSRC10 EQU   #1B432
=CSRC3  EQU   #1B421
=CSRC4  EQU   #1B41E
=CSRC5  EQU   #1B41B
=CSRC6  EQU   #1B418
=CSRC8  EQU   #1B42C
=D1FSTK EQU   #1955D
=D1MSTK EQU   #1954E
=EXAB2  EQU   #0D40E
=EXPEX- EQU   #0F178
=EXPEXC EQU   #0F186
=FD0    EQU   #2F8BB
=FNRTN4 EQU   #0F238
=FORSTK EQU   #2F59E
=FR0    EQU   #2F89B
=FR1    EQU   #2F8AB
=FUNCR1 EQU   #2F8AB
=GNXTCR EQU   #03064
=GTEXT++ EQU  #05192
=INTGR  EQU   #0F99B
=MEMERR EQU   #0944D
=MFERR  EQU   #09393
=MOVEDM EQU   #1B0EE
=MOVEUM EQU   #1B15C
=MP2-12 EQU   #0C432
=MSTKD1 EQU   #1953C
=NXTELM EQU   #148AC
=NTOKEN EQU   #0493B
=NUMCK  EQU   #0369D
=NXTSTM EQU   #08A48
=OAGNXT EQU   #03060
=OUTBY+ EQU   #02CE5
=OUTBYT EQU   #02CE8
=OUTELA EQU   #05303
=POP1N  EQU   #0BD1C
=RCCD2  EQU   #0D41C
=RDATTY EQU   #17CC6
=RESTPR EQU   #03172
=RNDAHX EQU   #136CB
=SCRTCH EQU   #2F901
=SFLAGC EQU   #13601
=SHRT   EQU   #0F96C
=SPLITA EQU   #0C6BF
=STAB2  EQU   #0D400
=STKVCT EQU   #1470C
=STMTR0 EQU   #2F871
=SYNTXe EQU   #02E2B
=TST12A EQU   #0D476
=VARP   EQU   #0350E
=eSUBSC EQU   #1C
=pCONFG EQU   #FB
=tTO    EQU   #F3
=uRES12 EQU   #0C994

pvect  ?B=0   B
       GOYES  hVER$

       GONC   hVER$1

hVER$  C=R3
       D1=C
       A=R2
       D1=D1- (VER$en)-(VER$st)-2
       CD1EX
       ?A>C   A
       GOYES  hVER$1
       D1=C
       R3=C
VER$st LCASC  ' VT:C'
VER$en DAT1=C (VER$en)-(VER$st)-2
hVER$1 RTNSXM
*
Ures12 GOVLNG =uRES12
cslc5  GOVLNG =CSLC5
csrc4  GOVLNG =CSRC4
csrc5  GOVLNG =CSRC5
stab2  GOVLNG =STAB2
d1fstk GOVLNG =D1FSTK
d1mstk GOVLNG =D1MSTK
invpar GOVLNG =ARGERR
ivvarE GOVLNG =RDATTY
mstkd1 GOVLNG =MSTKD1
movedm GOVLNG =MOVEDM
moveum GOVLNG =MOVEUM
nxtstm GOVLNG =NXTSTM
outby+ GOVLNG =OUTBY+
splita GOVLNG =SPLITA

**********************************************
* Nom : argan   - prÅparation aux
*                 manipulations,
*                 analyse des arguments.
* Nom : velm    - Calcul de l'adresse d'un
*                 ÅlÅment dont on connait les
*                 coordonnÅes dans le
*                 tableau.
*
* Remarques :
*       Sous la mstk on trouve le dope
*        vector,
*       se reporter aux routines STKVCT et
*       NXTELM pour conditions d'utilisation.
*
* Historique :
*
* Date        Programmeurs      Modifications
* --------- ---------------- ----------------
* 29/11/85    JJD              CrÅation
*
**********************************************

arg
       GOSBVL =RNDAHX  -> A[A] = arg en Hex
       GONC   invpar   Si nÅgatif -> err
       DAT0=A A        place arg dans F-R0-
       D1=D1+ 16       Passe au paramÉtre
*                      suivant
       D0=D0+ 5        Passe F-R0 suivant
       RTN

vexp-  GOSBVL =COLLAP  @ MSTK = @ FORSTK
vexpc  GOSBVL =EXPEXC  Evaluation
argan  CD0EX           Sauve D0 ...
       D0=(5) =FD0     ...dans FD0
       DAT0=C A        .
       D0=(2) =FR0     DÅbut de l'analyse
vect1  GOSUB  arg      F-R0-0 = L2
       GOSUB  arg      F-R0-1 = C1
       GOSUB  arg      F-R0-2 = L1
       GOSUB  mstkd1   PrÅserve le dope vect.
       A=DAT1 W        Lit le 'Dope vector'
       LCHEX  #A
       ?A<C   P        Si variable simple
       GOYES  ivvarE   | alors erreur
       C=A    W
       CSRC            Passe le type
       ST=0   9        ST=(9) 1 dim
       P=C    0        P = Nb de dim
       ?P=    2        Si base 2
       GOYES  vect2    | alors ST(9)= 0
       ST=1   9        | sinon ST(9)= 1
vect2  P=     0
       CSRC            Passe le nb de dim
       ST=0   8        ST(8)= base 0
       ?C=0   P        Base 0 ?
       GOYES  vect11   Oui ST=0 8
       ST=1   8        ST8= base 1
vect11 CSR    A        Passe et A[A]= nb col
       D0=D0- 10       F-R0-1 = C1
       ?ST=0  9        Si base 2
       GOYES  vect22   | alors continue
       C=0    A        | sinon
       ?ST=0  8        | si base 0
       GOYES  vect22   | | alors A[A]= 0
       C=C+1  A        | | sinon A[A]= 1
vect22 ST=0   0        ST0  pour 2 boucles
       A=DAT0 A        A(A)= C1
       ?A>C   A        Si dÅpassement
       GOYES  Esubsc   |alors ERR:Subcript
       ?ST=0  8        Si base 0
       GOYES  vect12   | alors ok
       ?A=0   A        | Sinon Si Col 0
       GOYES  Esubsc   | | alors ERR
       C=C-1  A        | Max col -1 si base 1
       A=A-1  A        | C1-1
vect12 C=C+1  A        C[A] = max colonnes
       DAT0=A A        F-R0-1 No col. norm
       D1=D1+ 3
       DAT1=C 3
       D1=D1- 3
       GOSUB  csrc4    C[A] = nb lignes
       CSR    A
       D0=D0+ 5        D0= #2F8A5 F-R0-2
vect13 A=DAT0 A        1 : F-R0-2 ; 2 : F-R0-0
       ?A>C   A        L1 ou L2 > lgn max ?
       GOYES  Esubsc
       ?ST=0  8        Base 0 ?
       GOYES  vect14
       ?A=0   A        Base 1 : Ligne 0 ?
       GOYES  Esubsc
       A=A-1  A        L1 ou L2 -1
       DAT0=A A
vect14 ?ST=1  0        2Éme boucle ?
       GOYES  vect15   Oui passe   la suite
       R0=A
       ST=1   0        PrÅpare 2Éme boucle
       D0=D0- 10       D0= #2F89B F-R0-0
       GONC   vect13
Esubsc P=     0
       LC(2)  =eSUBSC
mferr  GOVLNG =MFERR

vect15 C=R0
       A=A-C  A        L2>L1 ?
       GOC    Esubsc
       DAT0=A A        F-R0-0 = N = L2-L1
       ST=0   8        Pas de rÅÅcriture
*                      Dopvect
       GOSBVL =STKVCT  sinon Åcrase STMTR =
*                      DEST
       GOSUB  d1mstk
       SETHEX
       D1=D1+ 7
       P=     3
       C=0    WP
       C=C-1  WP
       P=     0
       DAT1=C 3
       D0=(5) =FUNCR1
       D1=D1- 7
       C=DAT1 W
       DAT0=C W
       D0=D0- 16
       C=DAT0 W
       R0=C
       GOSBVL =CSRC10
       A=C    A
       GOSUB  cslc5
       D=C    A
       GOSUB  cslc5
       C=A    A
       R1=C
       C=D    A

* Maintenant R0[15-10]= Addr et R0(A)= N
*            R1(A)= L1  et R1(9-5)= C1
       GOTO   velm

vnlmt
       C=R0
       C=C-1  A
       RTNC
       R0=C
       C=R1
       C=C+1  A
       R1=C
       A=C    A
       GOSUB  csrc5

* Calcul de l'adresse d'un ÅlÅment
* A= numÅro de ligne , C= numÅro de colonne
*
* Sortie : R0(15-11)= adresse de l'ÅlÅment
*          B= ÅlÅment 12 digits

velm   SETHEX
       D=C    A        D= n. de col
       C=0    A
       D0=(5) (=FUNCR1)+3
       P=     0
       C=DAT0 3        C(A)=  nb de col
       D0=D0- 3
       GOSUB  a-mult   l,0
       C=D    A        C= n. col
       C=C+A  A
       B=C    A
velm2  GOSUB  ofst
       D0=D0+ 11
       C=DAT0 A
       C=C+A  A        Calcul de l'adresse
       D1=D1+ 11
       DAT1=C A
       C=R0
       GOSUB  cslc5
       C=DAT1 A
       GOSUB  csrc5
       R0=C            R0[15-11] =addr de
*                      l'Ålmt
       ST=0   7
       GOSUB  d1mstk
       GOSBVL =NXTELM
       ?ST=0  5
       GOYES  velm21
       GOTO   mferr
velm21 D1=D1+ 16
       GOSUB  mstkd1   MSTK au dessus de
*                      Dopvect.
       P=     0
       SETHEX
       C=R0
       GOSUB  cslc5
       A=C    A
       RTN

* R0=(15-11) Addr de l'Ålmt; B=Ålmt; Ålmt on
* MSTK

* ofst
* calcule le dÅplacement de n. ÅlÅments
* B(A)= nb d'ÅlÅments
* D0= FR1


ofst   A=DAT0 P
       C=0    A
       LCHEX  #B
       ?A=C   P
       GOYES  vshr
       ?A<C   P
       GOYES  vint
       LCHEX  #10
       GOTO   mult
vshr   LCHEX  #9
       GOTO   mult
vint   LCHEX  #6
mult   ABEX   A
a-mult GOVLNG =A-MULT

**********************************************
*
* Nom : stelm
*
* Objet :
*       Chargement des ÅlÅments calculÅs dans
*       un tableau.
*
* Historique :
*
* Date       Programmeurs      Modifications
* --------- --------------- -----------------
* 29/11/85   JJD             CrÅation
*
**********************************************

stelm  GOSUB  Ures12
       SETHEX
st12   B=C    W
       C=R0
       GOSUB  cslc5
       D0=C
       GOSUB  d1mstk
       A=DAT1 B
       P=     0
       LCHEX  #B
       ?A=C   P
       GOYES  shorts
       ?A<C   P
       GOYES  intgrs
       A=B    W
       DAT0=A W
       GOTO   cfl-4
shorts
       A=B    W
       GOSBVL =SHRT
       GOTO   cfl-4
intgrs
       A=B    W
       GOSBVL =INTGR
cfl-4
       SETHEX
       P=     0
       RTN

**********************************************
*
* Nom : mov1
*
* Objet :
*      Placer une colonne d'un tableau sur la
*      mathstack.
*
* Historique :
*
* Date         Programmeurs     Modifications
* --------- ------------------ --------------
* 10/12/85    JJD               CrÅation
*
**********************************************

mov1   C=DAT1 W
       A=B    W
       DAT1=A W
       D1=D1- 16
       DAT1=C W
       GOSUB  mstkd1
       GOSUB  vnlmt
       RTNC
       GONC   mov1

**********************************************
*
* Routines de parsing et dÅcompilation
*
**********************************************

Plusd  GOSUB  arydc
       LCASC  '+'
       GONC   Prod1    (B.E.T)
Prod   GOSUB  arydc
       LCASC  '*'
Prod1  GOSBVL =OUTBYT
       GOSUB  arydc
       GONC   outela   (B.E.T)
Copyd  GOSUB  arydc-
       LC(2)  =tTO
       A=C    B
       GOSBVL =GTEXT++
Trid   GOSUB  arydc-
outela GOVLNG =OUTELA

arydc  D1=D1+ 2
arydc- LCASC  '('
       ST=0   5
       GOVLNG =ARYDC

Copyp  GOSUB  vectp
       GOSBVL =NTOKEN
       LC(2)  =tTO
       ?A#C   B
       GOYES  restpr
       GOSUB  outby+
       GOSUB  gnxtcr
       GOTO   vectp
restpr GOVLNG =RESTPR

ctep   GOSUB  gnxtcr
       LCASC  '('
       GOSUB  tken?
       GOSUB  outby+
       GOSUB  numck
       LCASC  ')'
       GOSUB  tken?
       GOVLNG =OAGNXT

Plusp  GOSUB  ctep
       LCASC  '+'
       GOTO   Prop1

Prop   GOSUB  ctep
       LCASC  '*'
Prop1  GOSUB  tken?
       D1=D1+ 2
vectp  GOSUB  gnxtcr
       LCASC  '('
       GOSUB  tken?
       D1=D1+ 2
       GOSBVL =VARP
       GOSBVL =COMCK
       LC(2)  2
       RSTK=C
arg3   GOSUB  numck
       C=RSTK
       C=C-1  B
       GOC    P+
       RSTK=C
       LCHEX  #F1
       GOSUB  tken?
       GONC   arg3
P+     LCASC  ')'
tken?  ?A#C   B
       GOYES  syntxE
       RTNCC
syntxE GOVLNG =SYNTXe
numck  GOVLNG =NUMCK
gnxtcr GOVLNG =GNXTCR

**********************************************
*
* Nom : VSUM    syntaxe : VSUM (V,L1,C1,L2)
*
* Objet : calculer la somme des ÅlÅments d'une
*         colonne d'un tableau, de la ligne L1
*         la ligne L2.
*
* Historique :
*
*    Date   Programmeur    Modifications
* -------- ------------- ---------------------
* 29/11/85  JJD           CrÅation
*
**********************************************

        NIBHEX 888A44
Sum
       GOSUB  argan
       SETDEC
       A=B    W
       GOSUB  splita
       GOSUB  stab2
       SETHEX
sum1
       GOSUB  vnlmt
       GOC    sum2
       ABEX   W
       SETDEC
       GOSUB  splita
       GOSBVL =RCCD2
       GOSBVL =AD2-15
       GOSUB  stab2
       SETHEX
       GOTO   sum1
sum2
       D0=(5) =FD0
       C=DAT0 A
       D0=C
       SETDEC
       GOSBVL =EXAB2
       GOSUB  Ures12
       GOVLNG =FNRTN4

**********************************************
*
* Nom : VPLUS   Syntaxe : VPLUS (X)+(V,L1,C1,L2)
*
* Objet :
*       Effectuer l'addition sur chacun des
*       termes d'une colonne d'un tableau par
*       une constante. Les nouveaux ÅlÅments
*       remplacent les valeurs initiales.
*
* Historique :
*
*    Date    Programmeur   Modifications
* -------- -------------- --------------------
* 28/12/85  JJD            CrÅation
*
**********************************************

ctepr
       D0=D0+ 2
       GOSBVL EXPEX-   Collapse la mstk et pose
*                      la constante.
       GOSBVL =POP1N
       SETHEX
       D1=(5) =STMTR0
       DAT1=A W        SCRTCH= Cte
       D0=D0+ 2        Passe TRMNTR )
       GOTO   vexp-

nxtval
       SETHEX
       GOSUB  d1mstk   pour uRES12
       ABEX   W
       D0=(5) =STMTR0
       C=DAT0 W
       SETDEC
       RTN

       REL(5) Plusd
       REL(5) Plusp
Plus
       GOSUB  ctepr
plus1
       GOSUB  nxtval
       GOSBVL =AD2-12
       GOSUB  stelm
       GOSUB  vnlmt
       GONC   plus1
       GOTO   nxtstm

**********************************************
*
* Nom : VPROD   Syntaxe : VPROD
*       (X)*(V,L1,C1,L2)
*
* Objet :
*       Effectuer le produit de chacun des
*       termes d'une colonne d'un tableau par
*       une constante. Les produits
*       remplacent les valeurs initiales de
*       la colonne.
* Historique :
*
*    Date    Programmeur   Modifications
* -------- -------------- --------------------
* 29/11/85  JJD            CrÅation
*
**********************************************

       REL(5) Prod
       REL(5) Prop
Pro
       GOSUB  ctepr
Pro1
       GOSUB  nxtval
       GOSBVL =MP2-12
       GOSUB  stelm
       GOSUB  vnlmt
       GONC   Pro1
       GOTO   nxtstm


**********************************************
*
* Nom : VCOPY
* Syntaxe : VCOPY (V1,L1,C1,L2) TO (V2,L3,C3,L4)
*
* Objet :
*       Effectuer une copy d'une colonne d'un
*       tableau sur une autre colonne. Les
*       tableaux peuvent Átre de types
*       diffÅrents
*       Les diffÅrences L2-L1 et L4-L3 ne
*       sont pas nÅcessairement Ågales, et il
*       est possible de copier une colonne sur
*       elle-mÁme.
*
* Historique
*
*
*    Date      Programmeur     modifications
* --------- ----------------- ----------------
* 15/12/85   JJD               CrÅation
*
**********************************************

       REL(5) Copyd
       REL(5) Copyp
Copy
       GOSUB  vexp-
       GOSUB  mov1
       D1=D1+ 16
       GOSUB  mstkd1
       D0=(5) =FD0
       C=DAT0 A
       D0=C
       D0=D0+ 2
       GOSUB  vexpc
       D1=(5) =FORSTK
       C=DAT1 A
       R2=C
       GOSUB  d1mstk
mov3
       A=R0
       C=R2
       CD1EX
       D1=D1- 16
       D1=D1- 16
       D1=D1- 16
       AD1EX
       ?A#C   A
       GOYES  more
       D1=(5) #00001
more   AD1EX
       R0=A
       A=C    A
       D1=D1+ 16
       D1=D1+ 16
       C=DAT1 W
       AD1EX
       R2=A
       GOSUB  st12
       GOSUB  vnlmt
       GONC   mov3
nxstmx GOTO   nxtstm

**********************************************
*
* Nom : VSORT      Syntaxe : VSORT (V,L1,C1,L2)
*
* Objet :
*       Trier les lignes d'un tableau suivant
*       les valeurs d'une colonne.
* Algorithme :
*       La colonne È trier est recopiÅe sur
*        la mstk oK È lieu le tri avec
*        actualisation d'une reprÅsentation
*        de l'ordre des lgns.
*        Les lgns du tableaux sont placÅes
*        dans l'ordre selon la
*        reprÅsentation.
*
* Historique :
*
*   Date    Programmeur          Modifications
* ------- ---------------- -------------------
* 28/12/85     JJD          CrÅation
* 14/01/86     JJD          Inversion du test
*                           et sortie si 1 lg
*
*********************************************

       REL(5) Trid
       REL(5) vectp
Tri
       GOSUB  vexp-
       GOSUB  mov1
       D0=(5) =FR0
       C=DAT0 A
       ?C=0   A
       GOYES  nxstmx
       D0=(2) (=FR0)+10
       C=DAT0 A
       D=C    A
       D0=D0- 10
       C=DAT0 A
       B=C    A
putnb
       D1=D1- 16
       AD1EX
       D1=(5) =AVMEMS
       C=DAT1 A
       C=C-A  A
       D1=A
       GOC    Tri1
memerr GOVLNG =MEMERR
Tri1
       C=D    W
       DAT1=C W
       D1=D1+ 5
       DAT1=C A
       D1=D1- 5
       C=C+1  A
       D=C    A
       B=B-1  A
       GONC   putnb
       GOSUB  mstkd1
       C=DAT0 A
       C=C+1  A
       C=C+1  A
       CSL    A
       R3=C
       D1=D1- 16
       AD1EX
       C=C+A  A
       R0=C            R0= Fin de tri
       D1=(5) =FORSTK
       C=DAT1 A
dep    D1=C            Positione les pointeurs
       D1=D1- 16       Fin de boucle ext ?
       CD1EX
       D1=C
       A=R0
       ?C#A   A        Pour D1= mstk to (top
*                      -1)
       GOYES  ext
       GOTO   res
ext    A=DAT1 W        Lit la valeur min
*                      supposÅe
       R2=A            R2=  val initiale
       R1=C            R1=  adr de val
       D0=C            D but de boucle interne
sup    D0=D0- 16       Val suivante
       AD0EX
       D0=A
       C=R0
       ?C>=A  A        Pour D0=D1 to top
       GOYES  nxt      Si fin de boucle int.
       A=R2            Rappel min supposÅ
       C=DAT0 W        Lit val act
       P=     6
       SB=0
       XM=0
       SETDEC
       GOSBVL =TST12A
       SETHEX
       GOC    sup
       CD0EX
       D0=C
       R1=C            R1 =>  pointe nouv min
       C=DAT0 W        Lit le nouveau min
       R2=C
       GOTO   sup      --->
nxt    C=R1            Fin de boucle interne
       D0=C            Pointe le min
       C=DAT1 W        Lit val initiale
       DAT0=C W        Remplace min par val
       A=R2            Rappel min
       DAT1=A W        Remplace val par min
       A=R3            Rappel offset
       CD0EX           Rappel adr de min
       C=C-A  A        Calcule adr de No de
*                      min
       D0=C            Pointe No de min
       CD1EX           Rappel adr de val
*                      initiale
       B=C    A        Sauve adr de val init.
       C=C-A  A        Adr de No de val
*                      initiale
       D1=C            Pointe No de val
*                      initiale
       A=DAT0 A        Lit le No de min
       C=DAT1 A        Lit le No initiale
       DAT0=C A        No init.   la place de
*                      min
       DAT1=A A        No min   la place No
*                      init.
       C=B    A        Rappel  adr val
       GOTO   dep
res
       GOSUB  d1fstk
       CD1EX           C[A] @ end of dest
       B=C    A        B[A] @ end of dest
       A=R3            A[A] = block length+16
       C=C-A  A        C[A] end of source
       AD1EX
       D1=D1- 16
       AD1EX           A[A]=block length
       ABEX   A        A[A] @ end of dest
       GOSUB  movedm
       D1=D1- 16
       GOSUB  mstkd1
       D0=(5) (=FR1)+3
       A=0    A
       A=DAT0 4
       B=A    A
       D0=(2) #AB
       GOSUB  ofst
       B=A    A
       GOSUB  d1mstk
       AD1EX
       A=A-B  A
       D1=(5) =AVMEMS
       C=DAT1 A
       C=C-A  A
       GOC    res1
       GOTO   memerr
res1   A=B    A
       GOSUB  d1fstk
       D1=D1- 11
       C=DAT1 A
       GOSUB  cslc5
       C=A    A
       R3=C            R3[10-5] No lgn;
*                      R3[A]=bl
       D1=D1- 5
       CD1EX
       D1=C
       RSTK=C
perm
       C=DAT1 W
       GOSUB  csrc5
       R1=C            R1=B...A
       C=R3
       GOSUB  csrc5
       A=C    A
       C=0    A
       GOSUB  velm
       C=R3
       B=C    A
       GOSUB  d1mstk
       D1=D1- 16
       AD1EX
       A=A-B  A
       CD1EX
       GOSUB  moveum

* D1 pointe @ end of dest
* D0 @ end of source ->
* -> @ end of dest pour le prochain move

       D1=D1+ 16       = D1MSTK [ passe
*                      element ]
       D1=D1+ 16
       C=RSTK
       RSTK=C
       CD0EX
       R2=C            R2[A]  @ end of dest
       AD1EX
       D1=A
       C=R3
       GOSUB  csrc5
       B=C    A        A[A]= No lgn È dÅplacer
       C=R1
       GOSUB  cslc5
       D=C    A
       D0=D0+ 5
b1     C=DAT0 A
       ?C=D   A
       GOYES  b2
       D0=D0- 16
       B=B+1  A
       CD0EX
       D0=C
       ?C>A   A
       GOYES  b1
       GOTO   mferr
b2     C=R1
       DAT0=C A
       A=B    A
       C=0    A
       GOSUB  velm     C[A] @ start of source
       A=R3
       B=A    A        B[A]= bl lgth
       A=R2
       A=A-B  A
       GOSUB  moveum

* Maintenant la nouvelle ligne est È sa place
* L'ancienne est sur la mathstack.
* RSTK @ descripteur courant
* R1= No triÅe....No lgn dest
* R3[9-5] = No lgn courante R3[A]= bl lgth

       C=R3
       B=C    A
       GOSUB  d1mstk
       D1=D1- 16
       CD1EX
       AD0EX
       GOSUB  movedm

* Maintenant l'ancienne lgn occupe la place
* de la lgn deplacÅe.

       GOSUB  d1mstk
       D1=D1+ 16
       AD1EX
       C=RSTK
       D1=C
       D1=D1- 16
       CD1EX
       ?C=A   A
       GOYES  nxtst2
       RSTK=C
       D1=C
       C=R3
       GOSUB  csrc5
       C=C+1  A
       GOSUB  cslc5
       R3=C
       GOTO   perm

nxtst2 GOVLNG =NXTSTM

       END