LEX    'EASTERLX' * A LEX file to calculate the date of Easter Sunday.
        ID     #EC      * The algorithm is given elsewhere.
        MSG    0        * J.Elhay, 4/12/87.
        POLL   0
        ENTRY  EASTER
        CHAR   #F       * a function
        KEY    'EASTER$'* Syntax: EASTER$(year), eg. year=1987
        TOKEN  51
        ENDTXT
ADHEAD  EQU    #181B7   * add header to string on stack
A-MULT  EQU    #1B349   * multiply two 20 bit integers
ARGERR  EQU    #0BF19   * invalid argument error exit
D=AVMS  EQU    #1A460   * needed by ADHEAD
HEXDEC  EQU    #0ECAF   * HEX integer to DEC integer conversion
IDIVA   EQU    #0EC6E   * integer divide routine, quotient & remainder result
RNDAHX  EQU    #136CB   * pop, round, test and convert a real number to HEX
iDIVA   GOVLNG IDIVA    * this saves bytes
a-MULT  GOVLNG A-MULT   * here too
ERR     GOVLNG ARGERR
        NIBHEX 811      * one obligatory numeric parameter
EASTER  GOSBVL RNDAHX   * HEX arithmetic saves many bytes over DEC
        GONC   ERR      * no negatives
        D1=D1+ 16       * top of stack
        CD1EX           * save D1
        D1=C            * copy back into D1
        R1=C            * and into R1 for ADHEAD
        LC(5)  #76C     * this is 1900 in HEX
        A=A-C  A        * subtract to get N
        R0=A            * save in R0
        LC(5)  #13      * load in 19 into C(A)
        GOSUB  iDIVA    * integer divide
        R2=C            * remainder in B(A) and C(A), save in R2
        ACEX   A        * want the remainder in A(A)
        P=     7        * 7 will be loaded into C(0)
        C=0    A        * clear C(A) in preparation
        CPEX   0        * C(0)=7 & P=0 now
        GOSUB  a-MULT   * this gives us 7*A
        A=A+1  A        * now 7*A+1
        LC(5)  #13      * load 19 into C(A)
        GOSUB  iDIVA    * integer divide
        R3=A            * save quotient in R3, this is B
        A=R2            * recall A into A(A)
        P=     0        * IDIVA leaves P=15
        LC(5)  #B       * load 11
        GOSUB  a-MULT   * 11*A
        C=R3            * recall B
        A=A-C  A        * 11*A-B
        C=0    A
        P=     4        * we want a 4 in C(A)
        CPEX   0        * the swap trick again
        A=A+C  A        * 11*A-B+4 in A(A)
        LC(5)  #1D      * load 29
        GOSUB  iDIVA    * divide
        R3=C            * overwrite B with remainder, M
        C=0    A
        A=R0            * this is N, recalled
        P=     4        * loading a 4
        CPEX   0        * with a swap
        GOSUB  iDIVA    * divide
        P=     0
        C=R0            * recall N
        A=A+C  A        * A(A) held N\4, this now N+N\4
        C=R3            * recall M
        A=A-C  A        * subtract, N+C-M (C=N\4)
        LC(5)  #1F      * load 31
        A=A+C  A        * N+C-M+31
        C=0    A
        P=     7        * load a 7 with another swap
        CPEX   0
        GOSUB  iDIVA    * divide
        A=R3            * remainder K in C(A) added M
        A=A+C  A
        P=     0
        LC(5)  #19      * load 25
        ACEX   A        * swap for subtraction
        A=A-C  A        * D=25-(M+K)
        ST=0   1        * clear ST1 in case of April
        ?A=0   A        * if true then date is 31 March
        GOYES  MARCH
        P=     4
        ?A=0   P        * if C(4)=0, then D>0 and we have April
        GOYES  APRIL
MARCH   P=     0        * otherwise we have to add 31
        LC(5)  #1F      * load 31
        A=A+C  A        * add
        ST=1   1        * set ST1 for return
        GOSUB  APRIL    * this converts 2-digit hex to ASCII
        LCASC  ' MARCH' * load C with ' MARCH'
        GOTO   FINISH
APRIL   GOSBVL HEXDEC   * HEX to DEC integer conversion
        C=0    A
        ACEX   A        * swap numeric result to C
        P=     0        * C(3,0)=00nx, P=0
        CPEX   1        * C(3,0)=000x, P=n
        CPEX   2        * C(3,0)=0n0x, P=0
        ACEX   A        * swap back to A(A)
        P=     0
        LCHEX  3030     * A(3,0)=0n0x, C(3,0)=3030
        A=A+C  A        * A(3,0)=3n3x, which is the ASCII for our number
        ?ST=1  1        * was ST1 set?
        RTNYES          * then return
        LCASC  ' APRIL' * load C with ' APRIL'
FINISH  D1=D1- 4        * prepare to write the number to stack
        DAT1=A 4        * write it
        D1=D1- 12       * now for the month name (by chance the same lengths)
        DAT1=C 12       * write
        ST=0   0        * needed by ADHEAD for no return
        GOSBVL D=AVMS   * needed by ADHEAD
        GOVLNG ADHEAD   * and exit