LEX   'APPT1'
       ID    #5E
       MSG   0
       POLL  polhnd
       ENTRY  setalm
       CHAR   13
       KEY    'SETALARM'
       TOKEN  1
       ENDTXT
       EJECT
*
* EQU's
*
tALARM EQU    #E21C
pFTYPE EQU    #2D
FTBSCH EQU    #11093
CRETF+ EQU    #084C4
MGOSUB EQU    #1AF01
lFNAMh EQU    #10
lFTYPh EQU    #4
lFLAGh EQU    #2
lDATEh EQU    #6
lTIMEh EQU    #4
lFLENh EQU    #5
oFTYPh EQU    #10
BSERR  EQU    #0939A
CMPT   EQU    #125B2
SETALM EQU    #1290D
NXTSTM EQU    #08A48
RUNRTN EQU    #074EA
STOPDC EQU    #05303
POP1N  EQU    #0BD1C
FLDTH  EQU    #1B223
ARGERR EQU    #0BF19
FUNCD0 EQU    #2F8BB
FUNCD1 EQU    #2F8C0
EXPR   EQU    #0F23C
POP1S  EQU    #0BD38
flALRM EQU    #FFFC4
FUNCR0 EQU    #2F89B
SFLAGS EQU    #135FA
pSREQ  EQU    #F9
SCRTCH EQU    #2F901
SCREX0 EQU    #2F941
SCREX3 EQU    #2F971
ALARM6 EQU    #2F755
BP+C   EQU    #0EB40
PUTALM EQU    #12952
pDSWNK EQU    #FE
STRGCK EQU    #036BA
COMCK+ EQU    #032AE
SYNTXe EQU    #02E2B
RESPTR EQU    #03172
FIXDC  EQU    #05943
EXPEXC EQU    #0F186
MPY    EQU    #0ECBB
DECTIM EQU    #12E64
DECDAT EQU    #12FC6
       EJECT
****************************************
*     P O L L    h a n d l e r s       *
****************************************
*
* VER$ POLL
*
polhnd ?B=0   B        VER$ poll ?
       GOYES  hVER$0
       GONC   poll2    B.E.T.
hVER$0 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  ' ALM:a'
VER$en DAT1=C (VER$en)-(VER$st)-2
hVER$1 RTNSXM
*
* File type POLL
*
poll2  LC(2)  =pFTYPE
       ?B=C   B
       GOYES  hFTYP0
       GOTO   poll3
hFTYP0 GOSUB  hFTYP1
*
* ALARM file type
*
* Create code 8
* Copy code   0
* Execution   0 (No)
* Subheader   10 nibbles
*
       NIBHEX 800
       CON(2) 10
       NIBASC 'ALARM'
       CON(1) 1
       CON(4) =tALARM
       NIBHEX FF       end of table
*
hFTYP1 C=RSTK
       D1=C
       GOSBVL =FTBSCH
       GONC   hFTYP2
       A=B    S
       C=B    A
       D1=C
       XM=0
       RTNCC
hFTYP2 RTNSXM
*
* Service request POLL
*
poll3  LC(2)  =pSREQ
       ?B=C   B
       GOYES  hSREQ0
       GOTO   poll4
hSREQ0 D1=(5) (SCRTCH)
       C=R0
       DAT1=C W        save R0 in SCRTCH
       D1=D1+ #10
       C=R1
       DAT1=C W        save R1 in SCRTCH+16
       D1=(5) (=SCREX0)
       C=D    A
       DAT1=C A        save D[A] in SCREX0
       D1=D1+ 16
       C=RSTK
       DAT1=C A        1st sub level in SCREX1
       D1=D1+ 16
       C=RSTK
       DAT1=C A        2nd sub level in SCREX2
       D1=D1+ 16
       C=RSTK
       DAT1=C A        3rd sub level in SCREX3
       GOSBVL =CMPT
       D1=(5) (=ALARM6)
       A=DAT1 12       get ALARM6
       P=     11
       ?A=0   WP
       GOYES  hSREQ1   not our problem
       ?C<=A  WP
       GOYES  hSREQ1   past-due -> process
       P=     0
       A=0    W
       LC(1)  5
       GOSBVL =PUTALM
       C=0    A
       LC(3)  880
       D=C    A
       LC(5)  60000    60000 msec = 1 mn
       GOSBVL =BP+C
hSREQ1 D1=(5) (SCRTCH)
       C=DAT1 W
       R0=C            restore R0
       D1=D1+ 16
       C=DAT1 W
       R1=C            restore R1
       D1=(5) (=SCREX0)
       C=DAT1 A
       D=C    A        restore D[A]
       D1=(5) (=SCREX3)
       C=DAT1 A
       RSTK=C          3rd sub level from SCREX3
       D1=D1- 16
       C=DAT1 A
       RSTK=C          2nd sub level from SCREX2
       D1=D1- 16
       C=DAT1 A
       RSTK=C          1st sub level from SCREX1
       RTNSXM
*
* Wake up POLL
*
poll4  LC(2)  =pDSWNK
       ?B=C   B
       GOYES  hDSWN0
       RTNSXM
hDSWN0 D1=(5) (=SCRTCH)
       C=D    W
       DAT1=C W
       GOSBVL =CMPT
       D1=(5) (=ALARM6)
       A=DAT1 12       get ALARM6
       P=     11
       ?A=0   WP
       GOYES  hDSWN1   not our problem
       ?C<=A  WP
       GOYES  hDSWN1   past-due -> process
       P=     0
       A=0    W
       LC(1)  5
       GOSBVL =PUTALM
       C=0    A
       LC(3)  880      BEEP 880 Hz
       D=C    A
       LC(5)  60000    60000 msec = 1 mn
       GOSBVL =BP+C
hDSWN1 D1=(5) (=SCRTCH)
       C=DAT1 W
       D=C    W        restore D
       RTNSXM
       EJECT
*
*      SUBROUTINE FOR TEST FILE
*
expr   GOVLNG =EXPR
pop1s  GOVLNG =POP1S
argerr GOVLNG ARGERR
pophex GOSBVL =POP1N
       D1=D1+ 16
       GOSBVL =FLDTH
       GONC   argerr
       RTN
saveD0 CD0EX
       D0=(5) (=FUNCD0)
       DAT0=C A
       D0=C
       RTN
restD0 D0=(5) (=FUNCD0)
       C=DAT0 A
       D0=C
       RTN
saveD1 CD1EX
       D1=(5) (=FUNCD1)
       DAT1=C A
       D1=C
       RTN
restD1 D1=(5) (=FUNCD1)
       C=DAT1 A
       D1=C
       RTN
       EJECT
STALd  GOVLNG =FIXDC
strgck GOVLNG =STRGCK
STALp  GOSUB  strgck
       GOSBVL =COMCK+
       GOC    STALp0
       GOVLNG =SYNTXe
STALp0 GOSUB  strgck
       GOVLNG =RESPTR
timerr GOTO   argerr
       REL(5) =STALd
       REL(5) =STALp
setalm GOSBVL =EXPEXC
       GOSUB  saveD0
       GOSBVL =DECDAT
       GOC    timerr
       A=C    W        from sub ACLC24
       C=0    W
       P=     4
       LCHEX  2A3
       D=C    W
       GOSBVL =MPY
       R3=C
       GOSUB  restD0   restore D0
       D0=D0+ 2        D0 @ next token
       GOSBVL =EXPEXC  get parameter
       GOSUB  saveD0   save again D0 for exit
       GOSBVL =DECTIM  compute time
       GOC    timerr   if error
       A=R3            recover date
       P=     11       prepare ...
       A=A+C  WP       ... and add time and date
       P=     0
       LC(1)  5        alarm slot
       GOSBVL =SETALM
       GOSUB restD0    restore D0
       GOVLNG =NXTSTM  exit
       END