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