LEX    'TESTLEX'
* (c) 1987 PPC Paris et l'Auteur
* Fonctions de comparaisons numÅriques banalisÅes
* codage :
*   1 : <
*   2 : =
*   3 : <=
*   4 : >
*   5 : <>
*   6 : >=
       ID     #5C
       MSG    0
       POLL   0
       ENTRY  Step
       CHAR   #F
       ENTRY  Test
       CHAR   #F
       KEY    'STEP'   STEP ( X, C, n )
       TOKEN  20       Renvoie X si vrai, 0 sinon
       KEY    'TEST'   TEST ( X, C, n )
       TOKEN  21       Renvoie 1 si vrai, 0 sinon
       ENDTXT

ARGERR EQU    #0BF19   Invalid Arg
RNDAHX EQU    #136CB   dÅpile un rÅel en hexa A(A)
POP1R  EQU    #0E8FD   dÅpile rÅel, pas complexe
TST12A EQU    #0D476   compare 2 rÅels A(W) et C(W)
FNRTN4 EQU    #0F238   sortie de la fonction

Argerr GOVLNG ARGERR
* 3 paramÉtres numÅriques obligatoires pour STEP
       NIBHEX 88833
Step   ST=0   0        Flag 0 := 0 pour STEP
       GOTO   start    Saute dans le code commun
* TEST a aussi 3 paramÉtres numÅriques obligatoires
       NIBHEX 88833
Test   ST=1   0        Flag 0 := 1 pour TEST
start  GOSBVL RNDAHX   A(A) := n dÅpilÅ en hexa
       GONC   Argerr   mais n ne doit pas Átre <0
       LCHEX  #06      C(B) := 6 (limite sup.)
       ?A>C   B        n > 6 ?
       GOYES  Argerr   oui : erreur
       R0=A            non : ok, le sauver en R0
       D1=D1+ 16       D1 pointe sur C
       GOSBVL POP1R    rÅcupÉre C
       R1=A            sauver C en R1
       D1=D1+ 16       D1 pointe sur X
       GOSBVL POP1R    rÅcupÉre X
       R2=A            Sauve X en R2
       C=R0            rÅcupÉre n dans C(B)
       P=C    0        Pointeur P vaut n
       C=R1            registre C := paramÉtre C
       CD1EX           D1 est bien positionnÅ
       R3=C            aussi il faut le sauver
       CD1EX           et restaurer C pour le test
       GOSBVL TST12A   teste ! P = le test È faire
       C=0    W        efface C(W) pour la sortie
       GONC   OUT      Si Cy = 0, test ÅchouÅ, 0
       ?ST=0  0        STEP
       GOYES  stpout   Oui : rÅsultat = X
       P=     14       P est mis pour placer 1
       LC(1)  1        charge le 1
       P=     0        restaure le pointeur P
       GOTO OUT        Saute la prochaine ligne
stpout C=R2            Place X (le rÅsultat) en C(W)
OUT    A=R3            restaure D1 depuis R3
       D1=A            restaure D1
       GOSBVL FNRTN4   renvoie le rÅsultat
       END