LEX    'PPOLL'
* (c) Copyright PPC Paris 1986
        ID     #E1
        MSG    0
        POLL   0

        ENTRY  NLOOP
        CHAR   #F
        ENTRY  PPOLL
        CHAR   #F
        ENTRY  Sleep
        CHAR   #D
        ENTRY  SRQ
        CHAR   #F

        KEY    'NLOOP'
        TOKEN  62
        KEY    'PPOLL'
        TOKEN  63
        KEY    'SLEEP'
        TOKEN  64
        KEY    'SRQ'
        TOKEN  65

        ENDTXT

eXWORD  EQU    #23
bLEX    EQU    #BFC
LEXPIL  EQU    #FF
BSERR   EQU    #0939A
FNRTN1  EQU    #0F216
I/OFND  EQU    #118BA
HDFLT   EQU    #1B31B
SNAPBF  EQU    #2F7F0
FUNCD0  EQU    #2F8BB
GETLPs  EQU    #1D15
PUTC    EQU    #6B1C
GET     EQU    #6751
ERRORX  EQU    #342C
OUTELA  EQU    #05303
NXTSTM  EQU    #08A48
SLEEP   EQU    #006C2
CKSREQ  EQU    #00721

        NIBHEX 801
NLOOP   GOSUB  JUMPER   cherche la boite
        CON(5) GETLPs   È lettre hpil
        GOC    err      erreur?
        LC(4)  #0100    demande le
        GOSUB  SEND     nbre de periph
        A=0    A
        B=C    W
        A=C    B        AAD
        GOSUB  MPY
        A=A+C  A        AEP
        GOSUB  MPY
        GOSUB  MPY0
        A=A+C  A        AES
        GONC   SRQ1     B.E.T.

        NIBHEX 801
PPOLL   GOSUB  SIDY     envoie IDY 0
        A=C    B        rÅsultat du ppoll
        GONC   SRQ1     B.E.T.

        NIBHEX 801
SRQ     GOSUB  SIDY     envoie IDY 0
        CSR    A
        CSR    A
        A=C    P        (P=0)
        LC(1)  1
        A=A&C  P        isole bit SRQ
SRQ1    GOSBVL HDFLT    conv flottant
        D0=(5) FUNCD0
        C=DAT0 A
        CD0EX           restaure D0
        C=A    W        rÅsultat
        GOVLNG FNRTN1   fin

err     GOSUB  JUMPER
        CON(5) ERRORX

* ERRORX n'est pas une routine supportÅe;
* n'est valable que pour les versions A & B

SIDY    GOSUB  JUMPER   cherche la boite
        CON(5) GETLPs   au lettre hpil
        GOC    err      erreur?
        LC(4)  #1E00
SEND    GOSUB  JUMPER   envoie la commande
        CON(5) PUTC     au processeur d'e/s
        GOC    err      erreur?
        GOSUB  JUMPER   reµoit la
        CON(5) GET      rÅponse
        GOC    err      erreur?
        A=0    A        initialise A pour
        RTNCC           la suite

MPY     BSR    W
        BSR    W
        C=0    A
        C=B    B
MPY0    C=C+C  A        2
        D=C    A
        D=D+D  A        4
        C=C+D  A        6
        CSL    A        96
        C=C+D  A        100
        RTN

        REL(5) Sleepd
        REL(5) Sleepp
Sleep   CD0EX           sauve D0
        R0=C            et D1 en
        CD1EX           R0 et R1
        R1=C
        GOSBVL SLEEP    en sommeil lÅger
        GOSBVL CKSREQ   traite les SRQ
        C=R1
        D1=C            restaure D1
        C=R0            et
        D0=C            D0
        GOVLNG NXTSTM

Sleepp  RTNCC          parse: rien
Sleepd  GOVLNG OUTELA   dÅcompile: rien

JUMPER  RSTK=C
        CD1EX
        D1=(5) SNAPBF
        DAT1=C A
        D1=(2) (SNAPBF)+5
        C=RSTK
        DAT1=C W
        D1=(4) (SNAPBF)+21
        DAT1=A W
        D1=(2) (SNAPBF)+37
        C=B    A
        CPEX   5
        P=     6
        C=0    P
        GONC   JUMP05
        C=C-1  P
JUMP05  P=     7
        C=0    P
        C=C-1  P
        DAT1=C 8
        SETHEX
        P=     0
        LC(3)  bLEX
        GOSBVL I/OFND
        GONC   JUMP90
        LC(2)  LEXPIL
        B=C    A
        A=0    A
        A=A+1  A
JUMP10  C=DAT1 6
        ?C=0   B
        GOYES  JUMP90
        ?B#C   B
        GOYES  JUMP20
        CSR    W
        CSR    A
        ?A<C   B
        GOYES  JUMP20
        CSR    A
        CSR    A
        C=C-A  B
        GONC   JUMP30
JUMP20  D1=D1+ 11
        GONC   JUMP10
JUMP90  LC(4)  eXWORD
        GOVLNG BSERR
JUMP30  D1=D1+ 6
        C=DAT1 A
        B=C    A
        C=RSTK
        D1=C
        D1=D1+ 5
        CD1EX
        RSTK=C
        C=DAT1 A
        C=C+B A
        RSTK=C
        D1=(5) (SNAPBF)+21
        A=DAT1 W
        D1=D1+ 16
        C=DAT1 8
        B=C    A
        P=     7
        C=C+1  P
        GOC    JUMP50
        SETDEC
JUMP50  P=     6
        ?C#0   P
        GOYES  JUMP60
JUMP60  P=C    5
        D1=(4) (SNAPBF)+5
        C=DAT1 W
        D1=(2) SNAPBF
        RSTK=C
        C=DAT1 A
        D1=C
        C=RSTK
        RTN

        END