00010	;        WORKING VERSION 3.1  --- 3/10/82
00020	;
00030	;
00040		ORG	7000H
00050	PLUS	EQU	1
00060	MINUS	EQU	2
00070	MULT	EQU	3
00080	DIVIDE	EQU	4
00090	POWER	EQU	5
00100	NEGATE	EQU	6		;UNARY MINUS
00110	SIN	EQU	7
00120	COS	EQU	8
00130	TAN	EQU	9
00140	CSC	EQU	10
00150	SEC	EQU	11
00160	COT	EQU	12
00170	ISIN	EQU	13
00180	ICOS	EQU	14
00190	ITAN	EQU	15
00200	ICOT	EQU	16
00210	ISEC	EQU	17
00220	ICSC	EQU	18
00230	SINH	EQU	19
00240	COSH	EQU	20
00250	TANH	EQU	21
00260	CSCH	EQU	22
00270	SECH	EQU	23
00280	COTH	EQU	24
00290	ISINH	EQU	25
00300	ICOSH	EQU	26
00310	ITANH	EQU	27
00320	ICOTH	EQU	28
00330	ICSCH	EQU	29
00340	ISECH	EQU	30
00350	LOG	EQU	31
00360	EXP	EQU	32
00370	CONPI	EQU	33
00380	CONSTE	EQU	34
00390	NUMBER	EQU	35
00400	LPAREN	EQU	36
00410	RPAREN	EQU	37
00420	DIFFER	EQU	38
00430	ABS	EQU	39
00440	;
00450	NEITHR	EQU	3
00460	FIRST	EQU	2
00470	SECOND	EQU	1
00480	BOTH	EQU	0
00490	;
00500	PRIME	EQU	2827H		; "'" AND "("
00510	CLS	EQU	1C9H		;CLEAR SCREEN
00520	CR	EQU	13		;CARRIAGE RETURN
00530	;
00540	;
00550	START	JR	PATCH		;SKIP VECTORS
00560		JP	ALOKAT
00570		JP	LINK1
00580	PATCH	LD	HL,FREMEM
00590		LD	(ENDMEM+1),HL
00600		LD	HL,REDUCE
00610		LD	(SMPVEC+1),HL
00620		LD	DE,4080H	;INITIALIZE RAM ADDRESSES
00630		LD	HL,18F7H
00640		LD	BC,39
00650		LDIR
00660		LD	HL,VTYPE
00670		LD	B,26
00680	LOOP1	LD	(HL),1		;TYPES=VARIBLES
00690		INC	HL
00700		DJNZ	LOOP1
00710		LD	HL,0FFFFH	;STACK ADDRESS
00720		LD	(408EH),HL
00730		LD	HL,41C4H	;SOME UNKNOWN VECTOR
00740		LD	(HL),0C9H
00750		LD	HL,41A6H
00760		LD	(HL),0C3H
00770		INC	HL
00780		LD	DE,INERR	;ERROR MESSAGE
00790		LD	(HL),E
00800		INC	HL
00810		LD	(HL),D
00820		LD	A,0C9H		;RET INSTRUCTION
00830		LD	(41BEH),A
00840		LD	(41C1H),A
00850		LD	(41D0H),A
00860		LD	(40F2H),A
00870		XOR	A
00880		LD	(409CH),A
00890		LD	(4019H),A	;LOWER CASE
00900		LD	HL,16412	;STOP CURSOR FROM BLINKING
00910		LD	(HL),1
00920		CALL	CLS		;CLEAR SCREEN
00930		LD	HL,3C00H+20
00940		LD	(4020H),HL	;SET A TAB
00950		LD	HL,TITLE1
00960		CALL	OMESS
00970		LD	HL,3C00H+64+20
00980		LD	(4020H),HL	;SET OTHER TAB
00990		LD	HL,TITLE2
01000		CALL	OMESS
01010	;
01020	COMAND	LD	SP,0FFFFH
01030	ENDMEM	LD	HL,FREMEM
01040		LD	(POINTR),HL
01050		LD	A,'>'
01060		CALL	OUTA
01070		CALL	INPUT
01080		LD	A,(KBUFF)	;NO INPUT?
01090		OR	A
01100		JR	Z,COMAND
01110		CP	'$'		;COMMAND?
01120		JR	NZ,CMD4
01130		LD	A,(KBUFF+1)
01140		CP	'Q'
01150		JR	NZ,CMD1
01160		LD	(4019H),A	;SET TO UPPERCASE
01170		LD	HL,0473H	;IN CASE '$B' IS ACTIVE
01180		LD	(401EH),HL
01190		JP	402DH		;... BEFORE LEAVING
01200	CMD1	CP	'S'		;OUTPUT TO SCREEN?
01210		JR	NZ,CMD2
01220		LD	HL,0473H	;SCREEN DRIVER
01230		LD	(401EH),HL
01240		JR	COMAND
01250	CMD2	CP	'C'		;DECLARATION OF CONSTANTS?
01260		JP	Z,DOC
01270		CP	'V'		;DECLARATION OF VARIABLES?
01280		JP	Z,DOV
01290	CMD3	CP	'B'		;OUTPUT TO BOTH?
01300		JP	NZ,INERR
01310		LD	HL,4CE1H
01320		LD	(401EH),HL	;SAVE THE "DUAL" DRIVER
01330		JR	COMAND
01340	CMD4	CALL	PARSE		;TURN INTO A TREE
01350		LD	HL,DXMSG
01360		CALL	OMESS
01370	CMD5	CALL	384H		;SCAN KEYBOARD FOR 1 KEY
01380		CP	1		;BREAK KEY HIT?
01390		JR	NZ,CMD6
01400		LD	A,CR
01410		CALL	OUTA
01420		JP	COMAND
01430	CMD6	CP	'a'
01440		JR	C,CMD5
01450		CP	'z'+1
01460		JR	NC,CMD5
01470		LD	IX,VTYPE-'a'	;IS IT A CONSTANT?
01480		LD	B,A
01490		LD	(BYTE+2),A	;MODIFY NEXT INSTRUCTION
01500	BYTE	LD	A,(IX+00)	;TO BE CHANGED
01510		OR	A
01520		LD	A,B
01530		JR	Z,CMD5		;JUMP IF A CONSTANT
01540		CALL	OUTA
01550		LD	(DX),A
01560		LD	A,CR
01570		CALL	OUTA
01580		CALL	DIFF
01590	SMPVEC	CALL	REDUCE
01600		CALL	PRINTF
01610		JP	COMAND
01620	;
01630	TITLE1	DEFM	'"DIFF" by Jim Battle 82'
01640		DEFB	CR
01650		DEFB	0
01660	TITLE2	DEFM	'Version 3.1 --- 3/10/82'
01670		DEFB	CR
01680		DEFB	CR
01690		DEFB	0
01700	DXMSG	DEFM	'With respect to what variable? '
01710		DEFB	0
01720	;
01730	;--------------------------------------------------------
01740	;
01750	;SEND REGISTER A TO THE ACTIVE DEVICE
01760	;
01770	OUTA	PUSH	DE
01780		CALL	33H
01790		POP	DE
01800		RET
01810	;
01820	;--------------------------------------------------------
01830	;
01840	;PRINT OR INPUT CONSTANTS AND VARIABLES
01850	;
01860	DOC	LD	C,0
01870		LD	A,(KBUFF+2)
01880		OR	A
01890		JR	NZ,CORV5
01900		LD	HL,CONMES
01910		JR	CORV2
01920	DOV	LD	C,1
01930		LD	A,(KBUFF+2)
01940		OR	A
01950		JR	NZ,CORV5
01960		LD	HL,VARMES
01970	;
01980	CORV2	CALL	OMESS		;PRINT TYPE
01990		LD	HL,VTYPE	;FOR EACH VARIBLE
02000		LD	B,26
02010		LD	D,'a'
02020	CORV3	LD	A,(HL)
02030		INC	HL
02040		CP	C		;RIGHT TYPE?
02050		JR	NZ,CORV4
02060		LD	E,A
02070		LD	A,D
02080		PUSH	DE
02090		CALL	OUTA
02100		POP	DE
02110		LD	A,E
02120	CORV4	INC	D
02130		DJNZ	CORV3
02140		LD	A,13
02150		CALL	OUTA
02160		LD	A,CR
02170		CALL	OUTA
02180		JP	COMAND
02190	;
02200	CORV5	LD	HL,KBUFF+2
02210		LD	IX,VTYPE-'a'
02220	CORV6	LD	A,(HL)
02230		INC	HL
02240		CP	','
02250		JR	Z,CORV6
02260		OR	A
02270		JP	Z,COMAND
02280		CP	'a'
02290		JP	C,INERR
02300		CP	'z'+1
02310		JP	NC,INERR
02320		LD	(OFFSET+2),A	;MODIFY PROGRAM
02330	OFFSET	LD	(IX+00),C	;00 TO BE CHANGED
02340		JR	CORV6
02350	;
02360	CONMES	DEFM	'Constants: '
02370		DEFB	0
02380	VARMES	DEFM	'Variables: '
02390		DEFB	0
02400	;
02410	;--------------------------------------------------------
02420	;
02430	;LOCATE THE NEXT AVAILABLE CELL FOR USE, RETURNED IN IY.
02440	;
02450	ALOKAT	PUSH	DE
02460		LD	IY,(POINTR)
02470		LD	DE,400
02480		ADD	IY,DE		;<400 BYTES LEFT?
02490		JP	C,OMERR
02500		LD	IY,(POINTR)
02510		LD	DE,5
02520		ADD	IY,DE
02530		LD	(POINTR),IY
02540		POP	DE
02550		RET
02560	;
02570	;--------------------------------------------------------
02580	;
02590	;OUT OF MEMORY ERROR
02600	;
02610	OMERR	LD	HL,OMMESS
02620		CALL	OMESS
02630		JP	COMAND
02640	OMMESS	DEFM	'*** OUT OF MEMORY ***'
02650		DEFB	CR
02660		DEFB	0
02670	;
02680	;--------------------------------------------------------
02690	;
02700	;GET A LINE OF INPUT (CALLING ROUTINE PRINTS THE PROMPT)
02710	;... AND REMOVE ALL THE SPACES FROM THE BUFFER.
02720	;
02730	INPUT	PUSH	AF
02740		PUSH	BC
02750		PUSH	DE
02760		PUSH	HL
02770		LD	HL,KBUFF	;KEYBOARD BUFFER AREA
02780		LD	B,255		;MAXIMUM INPUT LENGTH
02790		CALL	40H		;LINE INPUT ROUTINE
02800		EX	DE,HL
02810		LD	L,B		;B=# KEYS INPUTTED
02820		LD	H,0
02830		ADD	HL,DE
02840		LD	(HL),0		;MARK END OF INPUT
02850	;
02860		LD	HL,KBUFF
02870		LD	DE,KBUFF
02880	CMPRS1	LD	A,(HL)
02890		INC	HL
02900		CP	' '
02910		JR	Z,CMPRS1	;SKIP SPACES
02920		LD	(DE),A		;OTHER THAN SPACE
02930		INC	DE
02940		OR	A
02950		JR	NZ,CMPRS1	;FINISH BUFFER
02960		POP	HL
02970		POP	DE
02980		POP	BC
02990		POP	AF
03000		RET
03010	;
03020	;--------------------------------------------------------
03030	;
03040	;GET NEXT ITEM (HL), WITH HL--> NEXT ITEM ON RETURN.
03050	;A HOLDS TYPE JUST READ; FPA1=# IF A INDICATES A NUMBER.
03060	;
03070	GETITM	LD	A,(HL)
03080		OR	A		;END OF BUFFER
03090		RET	Z		;END-OF-BUFF MARKER
03100		CP	'a'		;VARIABLE?
03110		JR	C,ITEM1
03120		CP	'z'+1
03130		JR	NC,ITEM1
03140		INC	HL
03150		RET
03160	ITEM1	CP	'.'		;TEST FOR NUMBER
03170		JR	Z,ITEM2
03180		CP	'0'
03190		JR	C,ITEM3
03200		CP	'9'+1
03210		JR	NC,ITEM3
03220	ITEM2	CALL	0E65H		;CONVERT (HL) TO #
03230		PUSH	HL
03240		CALL	0AB1H		;CSNG(FPA1)
03250		POP	HL
03260		LD	A,NUMBER	;TYPE=NUMBER
03270		RET
03280	ITEM3	CP	'('
03290		JR	NZ,ITEM4
03300		INC	HL
03310		LD	A,LPAREN
03320		RET
03330	ITEM4	CP	')'
03340		JR	NZ,ITEM5
03350		INC	HL
03360		LD	A,RPAREN
03370		RET
03380	;
03390	ITEM5	PUSH	HL		;SEARCH TABLE FOR A MATCH
03400		LD	DE,CTABLE	;CODE TABLE
03410		LD	B,0		;TYPE COUNTER
03420	;
03430	ITEM6	INC	B
03440	ITEM7	LD	A,(DE)		;MATCH MADE?
03450		OR	A
03460		JR	Z,ITMDUN	;DONE WITH SCAN
03470		CP	(HL)
03480		JR	NZ,ITEM8
03490		INC	HL
03500		INC	DE
03510		JR	ITEM7
03520	;
03530	ITEM8	INC	DE		;TEST FAILED
03540		LD	A,(DE)
03550		OR	A
03560		JR	NZ,ITEM8
03570		INC	DE		;DE-->NEXT CANDIDATE
03580		LD	A,(DE)		;END-OF-TABLE?
03590		CP	-1
03600		JP	Z,INERR		;INPUT ERROR
03610		POP	HL		;RESTORE STRING POINTER
03620		PUSH	HL
03630		JR	ITEM6
03640	ITMDUN	LD	A,B		;GET TYPE NUMBER
03650		POP	DE		;POP GARBAGE OFF STACK
03660		RET
03670	;
03680	;CODE TABLE:
03690	CTABLE	DEFM	'+'
03700		DEFB	0
03710		DEFM	'-'
03720		DEFB	0
03730		DEFM	'*'
03740		DEFB	0
03750		DEFM	'/'
03760		DEFB	0
03770		DEFB	91		;MAKESHIFT EXPONENTIATION
03780		DEFB	0
03790		DEFM	'-'		;UNARY MINUS
03800		DEFB	0
03810		DEFM	'SIN('
03820		DEFB	0
03830		DEFM	'COS('
03840		DEFB	0
03850		DEFM	'TAN('
03860		DEFB	0
03870		DEFM	'CSC('
03880		DEFB	0
03890		DEFM	'SEC('
03900		DEFB	0
03910		DEFM	'COT('
03920		DEFB	0
03930		DEFM	'SIN'
03940		DEFW	PRIME
03950		DEFB	0
03960		DEFM	'COS'
03970		DEFW	PRIME
03980		DEFB	0
03990		DEFM	'TAN'
04000		DEFW	PRIME
04010		DEFB	0
04020		DEFM	'COT'
04030		DEFW	PRIME
04040		DEFB	0
04050		DEFM	'SEC'
04060		DEFW	PRIME
04070		DEFB	0
04080		DEFM	'CSC'
04090		DEFW	PRIME
04100		DEFB	0
04110		DEFM	'SINH('
04120		DEFB	0
04130		DEFM	'COSH('
04140		DEFB	0
04150		DEFM	'TANH('
04160		DEFB	0
04170		DEFM	'CSCH('
04180		DEFB	0
04190		DEFM	'SECH('
04200		DEFB	0
04210		DEFM	'COTH('
04220		DEFB	0
04230		DEFM	'SINH'
04240		DEFW	PRIME
04250		DEFB	0
04260		DEFM	'COSH'
04270		DEFW	PRIME
04280		DEFB	0
04290		DEFM	'TANH'
04300		DEFW	PRIME
04310		DEFB	0
04320		DEFM	'COTH'
04330		DEFW	PRIME
04340		DEFB	0
04350		DEFM	'CSCH'
04360		DEFW	PRIME
04370		DEFB	0
04380		DEFM	'SECH'
04390		DEFW	PRIME
04400		DEFB	0
04410		DEFM	'LN('
04420		DEFB	0
04430		DEFM	'EXP('
04440		DEFB	0
04450	PI	DEFM	'PI'
04460		DEFB	0
04470	ENUM	DEFM	'E'
04480		DEFB	0
04490		DEFB	-1		;END OF TABLE
04500	;
04510	;--------------------------------------------------------
04520	HSTACK	DEFS	100		;HEIRARCHY STACK
04530	KBUFF	DEFS	256		;KEYBOARD INPUT
04540	VTYPE	DEFS	26		;VARIABLE TYPES
04550	POINTR	DEFW	0		;ALOCATION POINTER
04560	DEVICE	DEFB	0		;OUTPUT DEVICE
04570	DX	DEFB	0		;DIFFERENTIATION VARIABLE
04580	;--------------------------------------------------------
04590	;
04600	;LINK POINTER #1 OF PARENT CELL (IY) TO CELL (IX).
04610	;
04620	LINK1	PUSH	DE
04630		PUSH	IX
04640		POP	DE
04650		LD	(IY+1),E
04660		LD	(IY+2),D
04670		POP	DE
04680		RET
04690	;
04700	;--------------------------------------------------------
04710	;
04720	;LINK POINTER #2 OF PARENT CELL (IY) TO CELL (IX).
04730	;
04740	LINK2	PUSH	DE
04750		PUSH	IX
04760		POP	DE
04770		LD	(IY+3),E
04780		LD	(IY+4),D
04790		POP	DE
04800		RET
04810	;
04820	;--------------------------------------------------------
04830	;
04840	;BIND1 CREATES A CELL, ASSIGNS IT TO THE TYPE INDICATED
04850	;... BY THE BYTE FOLLOWING THE 'CALL' INSTRUCTION, AND
04860	;... LINKS THE NEW CELL TO THE ONE ON THE STACK.
04870	;
04880	BIND1	EX	AF,AF'		;SAVE ALL REGISTERS
04890		EXX
04900		PUSH	IX
04910		POP	DE
04920		POP	HL		;GET RETURN ADDRESS
04930		LD	A,(HL)		;GET TYPE BYTE
04940		POP	IX		;CELL TO BE LINKED
04950		CALL	ALOKAT		;MAKE NEW CELL
04960		LD	(IY),A		;SAVE TYPE
04970		CALL	LINK1
04980		PUSH	DE		;RESTORE IX
04990		POP	IX
05000		PUSH	IY		;SAVE IY UNDER RET ADDR
05010		INC	HL		;ADJUST RETURN ADDRESS
05020		PUSH	HL		;... AND SAVE IT
05030		EXX			;RESTORE REGISTERS
05040		EX	AF,AF'
05050		RET
05060	;
05070	;--------------------------------------------------------
05080	;
05090	;BIND2 FUNCTIONS LIKE BIND1, BUT BIND2 LINKS THE TWO
05100	;... CELLS ON THE STACK TO THE NEW ONE.
05110	;
05120	BIND2	EXX			;SAVE REGISTERS
05130		EX	AF,AF'
05140		PUSH	IX
05150		POP	DE
05160		POP	HL		;RETURN ADDRESS
05170		LD	A,(HL)		;GET TYPE BYTE
05180		POP	IX		;GET CELL TO LINK
05190		CALL	ALOKAT		;MAKE NEW CELL
05200		LD	(IY),A		;STORE TYPE
05210		CALL	LINK2		;LINK CELL (IX)
05220		POP	IX		;IX-->FIRST ARGUMENT
05230		CALL	LINK1
05240		PUSH	DE
05250		POP	IX		;RESTORE IX
05260		PUSH	IY		;SAVE IY UNDER RET ADDR
05270		INC	HL		;ADJUST RETURN ADDRESS
05280		PUSH	HL		;... AND SAVE IT
05290		EXX			;RESTORE REGISTERS
05300		EX	AF,AF'
05310		RET
05320	;
05330	;--------------------------------------------------------
05340	;
05350	;MAKE THE NUMBER INDICATED BY THE ENTRANCE ADDRESS
05360	;
05370	MAKE1	LD	A,129
05380		DEFB	1		;LD BC,....
05390	MAKE2	LD	A,130
05400		DEFB	1		;LD BC,....
05410	MAKEHF	LD	A,128
05420		CALL	ALOKAT
05430		LD	(IY),NUMBER		;TYPE=NUMBER
05440		LD	(IY+1),0	;MANTISSA=.5
05450		LD	(IY+2),0
05460		LD	(IY+3),0
05470		LD	(IY+4),A	;EXPONENT= *1, *2 OR *4
05480		EXX			;PUT IY UNDER RET ADDR
05490		POP	HL
05500		PUSH	IY
05510		PUSH	HL
05520		EXX
05530		RET
05540	;
05550	;--------------------------------------------------------
05560	;
05570	;PRINT "***ERROR***" WHEN AN ERROR HAS OCCURRED.
05580	;
05590	INERR	LD	HL,MESSG
05600		CALL	OMESS
05610		JP	COMAND		;RETURN TO INPUT SEQUENCE
05620	MESSG	DEFM	'*** ERROR ***'
05630		DEFB	CR
05640		DEFB	0
05650	;
05660	;--------------------------------------------------------
05670	;
05680	;PRINT THE BUFFER (HL) ON SCREEN UNTIL A 00 IS REACHED.
05690	;
05700	OMESS	LD	A,(HL)		;GET NEXT CHARACTER
05710		OR	A
05720		RET	Z		;TERMINATING BYTE?
05730		CALL	OUTA
05740		INC	HL
05750		JR	OMESS
05760	;
05770	;--------------------------------------------------------
05780	;
05790	;COPY A TREE STRUCTURE, STARTING AT CELL (IY).
05800	;... THE RETURNED TREE IS A DUPLICATE, STARTING AT (IY).
05810	;
05820	COPY	PUSH	IX		;SAVE FOR RECURSION
05830		PUSH	HL
05840		PUSH	DE
05850		PUSH	AF
05860		LD	A,(IY)		;GET BRANCH TYPE
05870		CP	NUMBER		;NUMBER?
05880		JR	NZ,COPY1
05890		PUSH	IY
05900		POP	IX		;IX-->NUMBER
05910		CALL	ALOKAT
05920		LD	(IY),NUMBER
05930		LD	A,(IX+1)	;COPY NUMBER
05940		LD	(IY+1),A
05950		LD	A,(IX+2)
05960		LD	(IY+2),A
05970		LD	A,(IX+3)
05980		LD	(IY+3),A
05990		LD	A,(IX+4)
06000		LD	(IY+4),A
06010		JP	COPDUN
06020	;
06030	COPY1	CP	'a'		;VARIABLE?
06040		JR	C,COPY2
06050		CALL	ALOKAT
06060		LD	(IY),A
06070		JP	COPDUN
06080	;
06090	COPY2	CP	6		;BINARY FUNCTION?
06100		JR	NC,COPY3
06110		LD	E,(IY+1)
06120		LD	D,(IY+2)
06130		LD	L,(IY+3)
06140		LD	H,(IY+4)
06150		PUSH	DE
06160		POP	IY
06170		CALL	COPY
06180		PUSH	HL
06190		POP	IY
06200		CALL	COPY
06210		CALL	ALOKAT
06220		LD	(IY),A
06230		POP	IX
06240		CALL	LINK2
06250		POP	IX
06260		CALL	LINK1
06270		JR	COPDUN
06280	;
06290	COPY3	CP	CONPI		;#PI?
06300		JR	Z,COPY4
06310		CP	CONSTE		;#E
06320		JR	NZ,COPY5
06330	COPY4	CALL	ALOKAT
06340		LD	(IY),A		;SAVE #E OR #PI
06350		JR	COPDUN
06360	;
06370	COPY5	LD	L,(IY+1)
06380		LD	H,(IY+2)
06390		PUSH	HL
06400		POP	IY		;IY-->ARGUMENT
06410		CALL	COPY
06420		CALL	ALOKAT
06430		LD	(IY),A		;COPY FUNCTION
06440		POP	IX		;IX-->ARGUMENT
06450		CALL	LINK1
06460	;
06470	COPDUN	POP	AF
06480		POP	DE
06490		POP	HL
06500		POP	IX
06510		EXX			;SAVE IY UNDER RET ADDR
06520		POP	HL
06530		PUSH	IY
06540		PUSH	HL
06550		EXX
06560		RET
06570	;
06580	;--------------------------------------------------------
06590	;
06600	;PRINT OUT THE TREE BY RECURSIVE TECHNIQUES.
06610	;
06620	PRINTF	CALL	PRINT		;PRINT AND CR
06630		PUSH	AF
06640		LD	A,CR
06650		CALL	OUTA
06660		CALL	OUTA
06670		POP	AF
06680		RET
06690	;
06700	PRINT	PUSH	AF
06710		PUSH	BC
06720		PUSH	DE
06730		PUSH	HL
06740		PUSH	IX
06750		PUSH	IY
06760		LD	A,(IY)		;GET CELL TYPE
06770		CP	'a'		;VARIABLE?
06780		JR	C,PRNT1
06790		CALL	OUTA
06800		JP	PNTDUN
06810	;
06820	PRNT1	CP	NUMBER		;NUMBER
06830		JR	NZ,PRNT3
06840		LD	A,(IY+1)	;TRANSFER # TO FPA1
06850		LD	(4121H),A
06860		LD	A,(IY+2)
06870		LD	(4122H),A
06880		LD	A,(IY+3)
06890		LD	(4123H),A
06900		LD	A,(IY+4)
06910		LD	(4124H),A
06920		CALL	0AEFH		;SET TYPE TO SINGLE
06930		CALL	0FBDH		;CONVERT TO ASCII
06940		LD	HL,4130H	;STORAGE OF ASCII
06950		LD	A,(HL)
06960		CP	' '
06970		JR	NZ,PRNT2
06980		INC	HL
06990	PRNT2	CALL	OMESS		;PRINT ON SCREEN
07000		JP	PNTDUN
07010	;
07020	PRNT3	CP	DIFFER		;d(Variable)?
07030		JR	NZ,PRNT4
07040		LD	A,'d'
07050		CALL	OUTA
07060		LD	A,(IY+1)	;GET VARIABLE
07070		CALL	OUTA
07080		JP	PNTDUN
07090	;
07100	PRNT4	CP	POWER+1		;BINARY OPERATOR?
07110		JR	NC,PRNT9
07120		LD	E,(IY+1)
07130		LD	D,(IY+2)
07140		CALL	PRIOR1		;SHOULD WE PRINT ()?
07150		JR	NZ,PRNT5
07160		PUSH	AF
07170		LD	A,'('
07180		CALL	OUTA
07190		POP	AF
07200	PRNT5	PUSH	IY
07210		PUSH	DE
07220		POP	IY
07230		CALL	PRINT
07240		JR	NZ,PRNT5A
07250		LD	A,')'
07260		CALL	OUTA
07270	PRNT5A	POP	IY
07280		LD	A,(IY)
07290		LD	B,'+'		;DETERMINE OPERATOR
07300		CP	PLUS
07310		JR	Z,PRNT6
07320		LD	B,'-'
07330		CP	MINUS
07340		JR	Z,PRNT6
07350		LD	B,'*'
07360		CP	MULT
07370		JR	Z,PRNT6
07380		LD	B,'/'
07390		CP	DIVIDE
07400		JR	Z,PRNT6
07410		LD	B,94		;UP-ARROW
07420	PRNT6	LD	A,B
07430		CALL	OUTA		;PRINT OPERATOR
07440	PRNT7	LD	L,(IY+3)
07450		LD	H,(IY+4)
07460		PUSH	IY
07470		CALL	PRIOR2		;() ON SECOND ARGUMENT?
07480		JR	NZ,PRNT8
07490		PUSH	AF
07500		LD	A,'('
07510		CALL	OUTA
07520		POP	AF
07530	PRNT8	PUSH	HL
07540		POP	IY		;IY-->SECOND OPERAND
07550		CALL	PRINT
07560		POP	IY
07570		JP	NZ,PNTDUN
07580		LD	A,')'
07590		CALL	OUTA
07600		JP	PNTDUN
07610	;
07620	PRNT9	CP	CONPI		;#PI?
07630		JR	NZ,PRNT10
07640		LD	HL,PI
07650		CALL	OMESS
07660		JP	PNTDUN
07670	;
07680	PRNT10	CP	CONSTE
07690		JR	NZ,PRNT11
07700		LD	HL,ENUM
07710		CALL	OMESS
07720		JP	PNTDUN
07730	;
07740	PRNT11	CP	ABS
07750		JR	NZ,PRNT12
07760		LD	HL,ABSMSG
07770		JR	PRNT12
07780	;
07790	PRNT12	CP	NEGATE		;UNARY MINUS?
07800		JR	NZ,PRNT14
07810		LD	L,(IY+1)
07820		LD	H,(IY+2)
07830		LD	A,(HL)
07840		CP	NEGATE
07850		JR	NC,PRNT13
07860		LD	A,'-'
07870		CALL	OUTA
07880		LD	A,'('
07890		CALL	OUTA
07900		PUSH	HL
07910		POP	IY
07920		CALL	PRINT
07930		LD	A,')'
07940		CALL	OUTA
07950		JP	PNTDUN
07960	PRNT13	PUSH	HL
07970		POP	IY
07980		LD	A,'-'
07990		CALL	OUTA
08000		CALL	PRINT
08010		JP	PNTDUN
08020	;
08030	PRNT14	LD	HL,CTABLE	;IT IS A FUNCTION
08040		LD	B,A
08050	PRNT15	DEC	B
08060		JR	Z,PRNT17
08070	PRNT16	LD	A,(HL)		;PASS THIS FUNC DESCRIP.
08080		INC	HL
08090		OR	A
08100		JR	NZ,PRNT16
08110		JR	PRNT15
08120	PRNT17	CALL	OMESS
08130		LD	L,(IY+1)
08140		LD	H,(IY+2)
08150		PUSH	HL
08160		POP	IY
08170		CALL	PRINT
08180		LD	A,')'
08190		CALL	OUTA
08200	;
08210	PNTDUN	POP	IY
08220		POP	IX
08230		POP	HL
08240		POP	DE
08250		POP	BC
08260		POP	AF
08270		RET
08280	;
08290	ABSMSG	DEFM	'ABS('
08300		DEFB	0
08310	;
08320	;--------------------------------------------------------
08330	;
08340	;DETERMINE IF () SHOULD BE AROUND THE FIRST OPERAND
08350	;
08360	PRIOR1	PUSH	BC
08370		PUSH	IX
08380		LD	A,(DE)		;FIRST ARG
08390		CP	NEGATE
08400		JR	Z,PR1DUN	;Z IS SET
08410		JR	NC,PR1DUN	;Z IS RESET
08420		DEC	A
08430		LD	B,A
08440		LD	A,(IY)
08450		DEC	A
08460		LD	C,A		;A*1
08470		ADD	A,A		;A*2
08480		ADD	A,A		;A*4
08490		ADD	A,C		;A*5
08500		ADD	A,B
08510		LD	IX,PTABLE	;PRIORITY TABLE
08520		LD	(PR1+2),A	;MODIFY NEXT INSTRUCTION
08530	PR1	LD	A,(IX+00)
08540		AND	1		;MASK ZERO BIT
08550	PR1DUN	POP	IX
08560		POP	BC
08570		RET
08580	;
08590	;--------------------------------------------------------
08600	;
08610	;DETERMINE IF () SHOULD BE PRINTED AROUND SECOND OPERAND
08620	;
08630	PRIOR2	PUSH	BC
08640		PUSH	IX
08650		LD	A,(HL)		;SECOND ARGUMENT
08660		CP	NEGATE
08670		JR	Z,PR2DUN	;Z IS SET
08680		JR	NC,PR2DUN	;Z IS RESET
08690		DEC	A
08700		LD	B,A
08710		LD	A,(IY)
08720		DEC	A
08730		LD	C,A		;A*1
08740		ADD	A,A		;A*2
08750		ADD	A,A		;A*4
08760		ADD	A,C		;A*5
08770		ADD	A,B
08780		LD	IX,PTABLE
08790		LD	(PR2+2),A	;MODIFY NEXT INSTRUCTION
08800	PR2	LD	A,(IX+00)
08810		AND	2		;MASK OUT SECOND BIT
08820	PR2DUN	POP	IX
08830		POP	BC
08840		RET
08850	;
08860	;--------------------------------------------------------
08870	;
08880	;PRIORITY TABLE
08890	;
08900	PTABLE	DEFB	NEITHR		;PARENT NODE IS '+'
08910		DEFB	NEITHR
08920		DEFB	NEITHR
08930		DEFB	NEITHR
08940		DEFB	NEITHR
08950		DEFB	SECOND		;PARENT NODE IS '-'
08960		DEFB	SECOND
08970		DEFB	NEITHR
08980		DEFB	NEITHR
08990		DEFB	NEITHR
09000		DEFB	BOTH		;PARENT NODE IS '*'
09010		DEFB	BOTH
09020		DEFB	NEITHR
09030		DEFB	FIRST
09040		DEFB	FIRST
09050		DEFB	BOTH		;PARENT NODE IS '/'
09060		DEFB	BOTH
09070		DEFB	SECOND
09080		DEFB	BOTH
09090		DEFB	SECOND
09100		DEFB	BOTH		;PARENT NODE IS '**'
09110		DEFB	BOTH
09120		DEFB	BOTH
09130		DEFB	BOTH
09140		DEFB	BOTH
09150	;
09160	;--------------------------------------------------------
09170	;
09180	;DIFFERENTIATE THE TREE POINTED TO BY (IY).
09190	;... RECURSION IS USED EXTENSIVELY.
09200	;
09210	DIFF	PUSH	HL
09220		PUSH	DE
09230		PUSH	BC
09240		PUSH	AF
09250		PUSH	IX
09260		LD	E,(IY+1)
09270		LD	D,(IY+2)	; u
09280		LD	L,(IY+3)	; v
09290		LD	H,(IY+4)
09300		LD	A,(IY)		;GET TYPE
09310		CP	NUMBER		;NUMBER?
09320		JR	Z,DIF1
09330		CP	CONPI		;#PI
09340		JR	Z,DIF1
09350		CP	CONSTE
09360		JR	NZ,DIF2
09370	;
09380	DIF1	CALL	ALOKAT		;RETURN A ZERO
09390		LD	(IY),NUMBER
09400		LD	(IY+4),0	;EXPONENT=0
09410		JP	DIFEND
09420	;
09430	DIF2	LD	B,A		;DIFFERENTIATION VARIABLE
09440		LD	A,(DX)
09450		CP	B
09460		LD	A,B
09470		JR	NZ,DIF3
09480		CALL	MAKE1
09490		POP	IY
09500		JP	DIFEND
09510	;
09520	DIF3	CP	'a'		;VARIABLE OTHER THAN
09530		JR	C,DIF4		;... SPECIFIED
09540		LD	B,A
09550		LD	IX,VTYPE-'a'
09560		LD	(INSTR+2),A	;MODIFY NEXT INSTRUCTION
09570	INSTR	LD	A,(IX+00)	;INDEX TO BE MODIFIED
09580		OR	A		;SET OR RESET Z-FLAG
09590		LD	A,B
09600		JR	Z,DIF1		;RETURN 0 IF A CONSTANT
09610		CALL	ALOKAT
09620		LD	(IY),DIFFER	;MAKE A d(Var)
09630		LD	(IY+1),A	;SAVE Var
09640		JP	DIFEND
09650	;
09660	DIF4	CP	PLUS		;ADDITION?
09670		JR	NZ,DIF5
09680		PUSH	DE
09690		POP	IY		;IY--> u
09700		CALL	DIFF		;MAKE du
09710		PUSH	IY
09720		PUSH	HL
09730		POP	IY		;IY--> v
09740		CALL	DIFF		;MAKE dv
09750		PUSH	IY
09760		CALL	BIND2		;MAKE du+dv
09770		DEFB	PLUS
09780		POP	IY
09790		JP	DIFEND
09800	;
09810	DIF5	CP	MINUS		;SUBTRACTION?
09820		JR	NZ,DIF6
09830		PUSH	DE
09840		POP	IY		;IY--> u
09850		CALL	DIFF		;MAKE du
09860		PUSH	IY
09870		PUSH	HL
09880		POP	IY		;IY--> v
09890		CALL	DIFF		;MAKE dv
09900		PUSH	IY
09910		CALL	BIND2		;MAKE du-dv
09920		DEFB	MINUS
09930		POP	IY
09940		JP	DIFEND
09950	;
09960	DIF6	CP	MULT		;MULTIPLY?
09970		JR	NZ,DIF7
09980		PUSH	DE
09990		POP	IY		;IY--> u
10000		CALL	COPY
10010		PUSH	HL
10020		POP	IY		;IY--> v
10030		CALL	DIFF		;MAKE dv
10040		PUSH	IY
10050		CALL	BIND2		;MAKE u * dv
10060		DEFB	MULT
10070		PUSH	HL
10080		POP	IY		;IY--> v
10090		CALL	COPY
10100		PUSH	DE
10110		POP	IY		;IY--> u
10120		CALL	DIFF		;MAKE du
10130		PUSH	IY
10140		CALL	BIND2		;MAKE v * du
10150		DEFB	MULT
10160		CALL	BIND2		;MAKE u * dv + v * du
10170		DEFB	PLUS
10180		POP	IY
10190		JP	DIFEND
10200	;
10210	DIF7	CP	DIVIDE
10220		JR	NZ,DIF8
10230		PUSH	HL
10240		POP	IY		;IY--> v
10250		CALL	COPY
10260		PUSH	DE
10270		POP	IY		;IY--> u
10280		CALL	DIFF		;MAKE du
10290		PUSH	IY
10300		CALL	BIND2		;MAKE v * du
10310		DEFB	MULT
10320		PUSH	DE
10330		POP	IY		;IY--> u
10340		CALL	COPY
10350		PUSH	HL
10360		POP	IY		;IY--> v
10370		CALL	DIFF		;MAKE dv
10380		PUSH	IY
10390		CALL	BIND2		;MAKE u * dv
10400		DEFB	MULT
10410		CALL	BIND2		;MAKE v * du - u * dv
10420		DEFB	MINUS
10430		PUSH	HL
10440		POP	IY		;IY--> v
10450		CALL	COPY
10460		CALL	MAKE2
10470		CALL	BIND2		;MAKE u ** 2
10480		DEFB	POWER
10490		CALL	BIND2		;MAKE (v*du-u*dv)/(v**2)
10500		DEFB	DIVIDE
10510		POP	IY
10520		JP	DIFEND
10530	;
10540	DIF8	CP	POWER		;EXPONENTIATION?
10550		JR	NZ,DIF9
10560		PUSH	HL
10570		POP	IY		;IY--> v
10580		CALL	COPY
10590		PUSH	DE
10600		POP	IY		;IY--> u
10610		CALL	COPY
10620		PUSH	HL
10630		POP	IY		;IY--> v
10640		CALL	COPY
10650		CALL	MAKE1
10660		CALL	BIND2		;MAKE v - 1
10670		DEFB	MINUS
10680		CALL	BIND2		;MAKE u ** (v - 1)
10690		DEFB	POWER
10700		CALL	BIND2		;MAKE v*(u**(v-1))
10710		DEFB	MULT
10720		PUSH	DE
10730		POP	IY		;IY--> u
10740		CALL	DIFF		;MAKE du
10750		PUSH	IY
10760		CALL	BIND2		;MAKE v*(u**(v-1))*du
10770		DEFB	MULT
10780		PUSH	DE
10790		POP	IY		;IY--> u
10800		CALL	COPY
10810		CALL	BIND1		;MAKE LN(u)
10820		DEFB	LOG
10830		PUSH	DE
10840		POP	IY		;IY--> u
10850		CALL	COPY
10860		PUSH	HL
10870		POP	IY		;IY--> v
10880		CALL	COPY
10890		CALL	BIND2		;MAKE u ** v
10900		DEFB	POWER
10910		CALL	BIND2		;MAKE LN(u)*(u ** v)
10920		DEFB	MULT
10930		PUSH	HL
10940		POP	IY		;IY--> v
10950		CALL	DIFF
10960		PUSH	IY
10970		CALL	BIND2		;MAKE LN(u)* u**v * dv
10980		DEFB	MULT
10990		CALL	BIND2		;MAKE v*(u**(v-1))*du + LN(u)*(u**v)*dv
11000		DEFB	PLUS
11010		POP	IY
11020		JP	DIFEND
11030	;
11040	DIF9	CP	NEGATE		;UNARY MINUS?
11050		JR	NZ,DIF10
11060		PUSH	HL
11070		POP	IY		;IY--> u
11080		CALL	DIFF		;MAKE du
11090		PUSH	IY
11100		CALL	BIND1		;MAKE -du
11110		DEFB	NEGATE
11120		POP	IY
11130		JP	DIFEND
11140	;
11150	DIF10	CP	SIN
11160		JR	NZ,DIF11
11170		PUSH	DE
11180		POP	IY		;IY--> u
11190		CALL	COPY
11200		CALL	BIND1		;MAKE COS(u)
11210		DEFB	COS
11220		PUSH	DE
11230		POP	IY		;IY--> u
11240		CALL	DIFF		;MAKE du
11250		PUSH	IY
11260		CALL	BIND2		;MAKE COS(u)* du
11270		DEFB	MULT
11280		POP	IY
11290		JP	DIFEND
11300	;
11310	DIF11	CP	COS
11320		JR	NZ,DIF12
11330		PUSH	DE
11340		POP	IY		;IY--> u
11350		CALL	COPY
11360		CALL	BIND1		;MAKE SIN(u)
11370		DEFB	SIN
11380		PUSH	DE
11390		POP	IY		;IY-->u
11400		CALL	DIFF		;MAKE du
11410		PUSH	IY
11420		CALL	BIND2		;MAKE SIN(u) * du
11430		DEFB	MULT
11440		CALL	BIND1		;MAKE -SIN(u) * du
11450		DEFB	NEGATE
11460		POP	IY
11470		JP	DIFEND
11480	;
11490	DIF12	CP	TAN
11500		JR	NZ,DIF13
11510		PUSH	DE
11520		POP	IY		;IY--> u
11530		CALL	COPY
11540		CALL	BIND1		;MAKE SEC(u)
11550		DEFB	SEC
11560		CALL	MAKE2
11570		CALL	BIND2		;MAKE SEC(u)**2
11580		DEFB	POWER
11590		PUSH	DE
11600		POP	IY		;IY--> u
11610		CALL	DIFF
11620		PUSH	IY
11630		CALL	BIND2		;MAKE SEC(u)**2 * du
11640		DEFB	MULT
11650		POP	IY
11660		JP	DIFEND
11670	;
11680	DIF13	CP	CSC
11690		JR	NZ,DIF14
11700		PUSH	DE
11710		POP	IY
11720		CALL	COPY
11730		CALL	BIND1		;MAKE CSC(u)
11740		DEFB	CSC
11750		PUSH	DE
11760		POP	IY		;IY--> u
11770		CALL	COPY
11780		CALL	BIND1		;MAKE COT(u)
11790		DEFB	COT
11800		PUSH	DE
11810		POP	IY		;IY--> u
11820		CALL	DIFF		;MAKE du
11830		PUSH	IY
11840		CALL	BIND2		;MAKE COT(u) * du
11850		DEFB	MULT
11860		CALL	BIND2		;MAKE CSC(u)*COT(u)*du
11870		DEFB	MULT
11880		CALL	BIND1		;MAKE -CSC(u)*COT(u)*du
11890		DEFB	NEGATE
11900		POP	IY
11910		JP	DIFEND
11920	;
11930	DIF14	CP	SEC
11940		JR	NZ,DIF15
11950		PUSH	DE
11960		POP	IY		;IY--> u
11970		CALL	COPY
11980		CALL	BIND1		;MAKE SEC(u)
11990		DEFB	SEC
12000		PUSH	DE
12010		POP	IY		;IY--> u
12020		CALL	COPY
12030		CALL	BIND1		;MAKE TAN(u)
12040		DEFB	TAN
12050		PUSH	DE
12060		POP	IY		;IY--> u
12070		CALL	DIFF		;MAKE du
12080		PUSH	IY
12090		CALL	BIND2		;MAKE TAN(u) * du
12100		DEFB	MULT
12110		CALL	BIND2		;MAKE SEC(u)*TAN(u)*du
12120		DEFB	MULT
12130		POP	IY
12140		JP	DIFEND
12150	;
12160	DIF15	CP	COT
12170		JR	NZ,DIF16
12180		PUSH	DE
12190		POP	IY		;IY--> u
12200		CALL	COPY
12210		CALL	BIND1		;MAKE CSC(u)
12220		DEFB	CSC
12230		CALL	MAKE2
12240		CALL	BIND2		;MAKE CSC(u)**2
12250		DEFB	POWER
12260		PUSH	DE
12270		POP	IY		;IY--> u
12280		CALL	DIFF		;MAKE du
12290		PUSH	IY
12300		CALL	BIND2		;MAKE CSC(u)**2 * du
12310		DEFB	MULT
12320		POP	IY
12330		JP	DIFEND
12340	;
12350	DIF16	CP	ISIN
12360		JR	NZ,DIF17
12370		PUSH	DE
12380		POP	IY		;IY--> u
12390		CALL	DIFF		;MAKE du
12400		PUSH	IY
12410		CALL	MAKE1
12420		PUSH	DE
12430		POP	IY		;IY--> u
12440		CALL	COPY
12450		CALL	MAKE2
12460		CALL	BIND2		;MAKE u**2
12470		DEFB	POWER
12480		CALL	BIND2		;MAKE 1- u**2
12490		DEFB	MINUS
12500		CALL	MAKEHF
12510		CALL	BIND2		;MAKE SQR(1-u**2)
12520		DEFB	POWER
12530		CALL	BIND2		;MAKE du/SQR(1-u**2)
12540		DEFB	DIVIDE
12550		POP	IY
12560		JP	DIFEND
12570	;
12580	DIF17	CP	ICOS
12590		JR	NZ,DIF18
12600		PUSH	DE
12610		POP	IY		;IY--> u
12620		CALL	DIFF		;MAKE du
12630		PUSH	IY
12640		CALL	MAKE1
12650		PUSH	DE
12660		POP	IY		;IY--> u
12670		CALL	COPY
12680		CALL	MAKE2
12690		CALL	BIND2		;MAKE u**2
12700		DEFB	POWER
12710		CALL	BIND2		;MAKE 1-u**2
12720		DEFB	MINUS
12730		CALL	MAKEHF
12740		CALL	BIND2		;MAKE SQR(1-u**2)
12750		DEFB	POWER
12760		CALL	BIND2		;MAKE du/SQR(1-u**2)
12770		DEFB	DIVIDE
12780		CALL	BIND1		;MAKE -du/SQR(1-u**2)
12790		DEFB	NEGATE
12800		POP	IY
12810		JP	DIFEND
12820	;
12830	DIF18	CP	ITAN
12840		JR	NZ,DIF19
12850		PUSH	DE
12860		POP	IY		;IY--> u
12870		CALL	DIFF		;MAKE du
12880		PUSH	IY
12890		PUSH	DE
12900		POP	IY		;IY--> u
12910		CALL	COPY
12920		CALL	MAKE2
12930		CALL	BIND2		;MAKE u**2
12940		DEFB	POWER
12950		CALL	MAKE1
12960		CALL	BIND2		;MAKE u**2 + 1
12970		DEFB	PLUS
12980		CALL	BIND2		;MAKE du/(u**2+1)
12990		DEFB	DIVIDE
13000		POP	IY
13010		JP	DIFEND
13020	;
13030	DIF19	CP	ICOT
13040		JR	NZ,DIF20
13050		PUSH	DE
13060		POP	IY		;IY--> u
13070		CALL	DIFF		;MAKE du
13080		PUSH	IY
13090		PUSH	DE
13100		POP	IY		;IY--> u
13110		CALL	COPY
13120		CALL	MAKE2
13130		CALL	BIND2		;MAKE u**2
13140		DEFB	POWER
13150		CALL	MAKE1
13160		CALL	BIND2		;MAKE u**2 + 1
13170		DEFB	PLUS
13180		CALL	BIND2		;MAKE du/(u**2 + 1)
13190		DEFB	DIVIDE
13200		CALL	BIND1		;MAKE -du/(u**2+1)
13210		DEFB	NEGATE
13220		POP	IY
13230		JP	DIFEND
13240	;
13250	DIF20	CP	ISEC
13260		JR	NZ,DIF21
13270		PUSH	DE
13280		POP	IY		;IY--> u
13290		CALL	DIFF		;MAKE du
13300		PUSH	IY
13310		PUSH	DE
13320		POP	IY		;IY--> u
13330		CALL	COPY
13340		CALL	BIND1		;MAKE ABS(u)
13350		DEFB	ABS
13360		PUSH	DE
13370		POP	IY		;IY--> u
13380		CALL	COPY
13390		CALL	MAKE2
13400		CALL	BIND2		;MAKE u**2
13410		DEFB	POWER
13420		CALL	MAKE1
13430		CALL	BIND2		;MAKE u**2 - 1
13440		DEFB	MINUS
13450		CALL	MAKEHF
13460		CALL	BIND2		;MAKE SQR(u**2-1)
13470		DEFB	POWER
13480		CALL	BIND2		;MAKE ABS(u)*SQR(u**2-1)
13490		DEFB	MULT
13500		CALL	BIND2		;MAKE du/(ABS(u)*SQR(u**2-1))
13510		DEFB	DIVIDE
13520		POP	IY
13530		JP	DIFEND
13540	;
13550	DIF21	CP	ICSC
13560		JR	NZ,DIF22
13570		PUSH	DE
13580		POP	IY		;IY-->u
13590		CALL	DIFF		;MAKE du
13600		PUSH	IY
13610		PUSH	DE
13620		POP	IY		;IY--> u
13630		CALL	COPY
13640		CALL	BIND1		;MAKE ABS(u)
13650		DEFB	ABS
13660		PUSH	DE
13670		POP	IY		;IY--> u
13680		CALL	COPY
13690		CALL	MAKE2
13700		CALL	BIND2		;MAKE u**2
13710		DEFB	POWER
13720		CALL	MAKE1
13730		CALL	BIND2		;MAKE u**2 - 1
13740		DEFB	MINUS
13750		CALL	MAKEHF
13760		CALL	BIND2		;MAKE SQR(u**2-1)
13770		DEFB	POWER
13780		CALL	BIND2		;MAKE ABS(u)*SQR(u**2-1)
13790		DEFB	MULT
13800		CALL	BIND2		;MAKE du/(ABS(u)*SQR(u**2-1))
13810		DEFB	DIVIDE
13820		CALL	BIND1		;MAKE -du/(ABS(u)*SQR(u**2-1))
13830		DEFB	NEGATE
13840		POP	IY
13850		JP	DIFEND
13860	;
13870	DIF22	CP	SINH
13880		JR	NZ,DIF23
13890		PUSH	DE
13900		POP	IY
13910		CALL	COPY
13920		CALL	BIND1		;MAKE COSH(u)
13930		DEFB	COSH
13940		PUSH	DE
13950		POP	IY
13960		CALL	DIFF		;MAKE du
13970		PUSH	IY
13980		CALL	BIND2		;MAKE COSH(u)* du
13990		DEFB	MULT
14000		POP	IY
14010		JP	DIFEND
14020	;
14030	DIF23	CP	COSH
14040		JR	NZ,DIF24
14050		PUSH	DE
14060		POP	IY
14070		CALL	COPY
14080		CALL	BIND1		;MAKE SINH(u)
14090		DEFB	SINH
14100		PUSH	DE
14110		POP	IY
14120		CALL	DIFF		;MAKE du
14130		PUSH	IY
14140		CALL	BIND2		;MAKE SINH(u) * du
14150		DEFB	MULT
14160		POP	IY
14170		JP	DIFEND
14180	;
14190	DIF24	CP	TANH
14200		JR	NZ,DIF25
14210		PUSH	DE
14220		POP	IY
14230		CALL	COPY
14240		CALL	BIND1		;MAKE SECH(u)
14250		DEFB	SECH
14260		CALL	MAKE2
14270		CALL	BIND2		;MAKE SECH(u)**2
14280		DEFB	POWER
14290		PUSH	DE
14300		POP	IY
14310		CALL	DIFF		;MAKE du
14320		PUSH	IY
14330		CALL	BIND2		;MAKE SECH(u)**2 * du
14340		DEFB	MULT
14350		POP	IY
14360		JP	DIFEND
14370	;
14380	DIF25	CP	CSCH
14390		JR	NZ,DIF26
14400		PUSH	DE
14410		POP	IY
14420		CALL	COPY
14430		CALL	BIND1		;MAKE CSCH(u)
14440		DEFB	CSCH
14450		PUSH	DE
14460		POP	IY
14470		CALL	COPY
14480		CALL	BIND1		;MAKE COTH(u)
14490		DEFB	COTH
14500		CALL	BIND2		;MAKE CSCH(u)*COTH(u)
14510		DEFB	MULT
14520		PUSH	DE
14530		POP	IY
14540		CALL	DIFF		;MAKE du
14550		PUSH	IY
14560		CALL	BIND2		;MAKE CSCH(u)*COTH(u)*du
14570		DEFB	MULT
14580		CALL	BIND1		;MAKE -CSCH(u)*COTH(u)*du
14590		DEFB	NEGATE
14600		POP	IY
14610		JP	DIFEND
14620	;
14630	DIF26	CP	SECH
14640		JR	NZ,DIF27
14650		PUSH	DE
14660		POP	IY
14670		CALL	COPY
14680		CALL	BIND1		;MAKE SECH(u)
14690		DEFB	SECH
14700		PUSH	DE
14710		POP	IY
14720		CALL	COPY
14730		CALL	BIND1		;MAKE TANH(u)
14740		DEFB	TANH
14750		CALL	BIND2		;MAKE SECH(u)*TANH(u)
14760		DEFB	MULT
14770		PUSH	DE
14780		POP	IY
14790		CALL	DIFF		;MAKE du
14800		PUSH	IY
14810		CALL	BIND2		;MAKE SECH(u)*TANH(u)*du
14820		DEFB	MULT
14830		CALL	BIND1		;MAKE -SECH(u)*TANH(u)*du
14840		DEFB	NEGATE
14850		POP	IY
14860		JP	DIFEND
14870	;
14880	DIF27	CP	COTH
14890		JR	NZ,DIF28
14900		PUSH	DE
14910		POP	IY
14920		CALL	COPY
14930		CALL	BIND1		;MAKE CSCH(u)
14940		DEFB	CSCH
14950		CALL	MAKE2
14960		CALL	BIND2		;MAKE CSCH(u)**2
14970		DEFB	POWER
14980		PUSH	DE
14990		POP	IY
15000		CALL	DIFF		;MAKE du
15010		PUSH	IY
15020		CALL	BIND2		;MAKE CSCH(u)**2 * du
15030		DEFB	MULT
15040		CALL	BIND1		;MAKE -CSCH(u)**2 * du
15050		DEFB	NEGATE
15060		POP	IY
15070		JP	DIFEND
15080	;
15090	DIF28	CP	ISINH
15100		JR	NZ,DIF29
15110		PUSH	DE
15120		POP	IY
15130		CALL	DIFF		;MAKE du
15140		PUSH	IY
15150		CALL	MAKE1
15160		PUSH	DE
15170		POP	IY
15180		CALL	COPY
15190		CALL	MAKE2
15200		CALL	BIND2		;MAKE u**2
15210		DEFB	POWER
15220		CALL	BIND2		;MAKE 1+u**2
15230		DEFB	PLUS
15240		CALL	MAKEHF
15250		CALL	BIND2		;MAKE SQR(1+u**2)
15260		DEFB	POWER
15270		CALL	BIND2		;MAKE du/SQR(1+u**2)
15280		DEFB	DIVIDE
15290		POP	IY
15300		JP	DIFEND
15310	;
15320	DIF29	CP	ICOSH
15330		JR	NZ,DIF30
15340		PUSH	DE
15350		POP	IY
15360		CALL	DIFF		;MAKE du
15370		PUSH	IY
15380		PUSH	DE
15390		POP	IY
15400		CALL	COPY
15410		CALL	MAKE2
15420		CALL	BIND2		;MAKE u**2
15430		DEFB	POWER
15440		CALL	MAKE1
15450		CALL	BIND2		;MAKE u**2 - 1
15460		DEFB	MINUS
15470		CALL	MAKEHF
15480		CALL	BIND2		;MAKE SQR(u**2-1)
15490		DEFB	POWER
15500		CALL	BIND2		;MAKE du/SQR(u**2-1)
15510		DEFB	DIVIDE
15520		POP	IY
15530		JP	DIFEND
15540	;
15550	DIF30	CP	ITANH
15560		JR	Z,DIF31
15570		CP	ICOTH
15580		JR	NZ,DIF32	;d(TANH'(u))=d(COTH'(u))
15590	DIF31	PUSH	DE
15600		POP	IY
15610		CALL	DIFF		;MAKE du
15620		PUSH	IY
15630		CALL	MAKE1
15640		PUSH	DE
15650		POP	IY
15660		CALL	COPY
15670		CALL	MAKE2
15680		CALL	BIND2		;MAKE u**2
15690		DEFB	POWER
15700		CALL	BIND2		;MAKE 1-u**2
15710		DEFB	MINUS
15720		CALL	BIND2		;MAKE du/(1-u**2)
15730		DEFB	DIVIDE
15740		POP	IY
15750		JP	DIFEND
15760	;
15770	DIF32	CP	ICSCH
15780		JR	NZ,DIF33
15790		PUSH	DE
15800		POP	IY
15810		CALL	DIFF		;MAKE du
15820		PUSH	IY
15830		PUSH	DE
15840		POP	IY
15850		CALL	COPY
15860		CALL	BIND1		;MAKE ABS(u)
15870		DEFB	ABS
15880		CALL	MAKE1
15890		PUSH	DE
15900		POP	IY
15910		CALL	COPY
15920		CALL	MAKE2
15930		CALL	BIND2		;MAKE u**2
15940		DEFB	POWER
15950		CALL	BIND2		;MAKE 1+ u**2
15960		DEFB	PLUS
15970		CALL	MAKEHF
15980		CALL	BIND2		;MAKE SQR(1+u**2)
15990		DEFB	POWER
16000		CALL	BIND2		;MAKE ABS(u)*SQR(1+u**2)
16010		DEFB	MULT
16020		CALL	BIND2		;MAKE du/(ABS(u)*SQR(1+u**2)
16030		DEFB	DIVIDE
16040		CALL	BIND1		;MAKE -du/(ABS(u)*SQR(1+u**2)
16050		DEFB	NEGATE
16060		POP	IY
16070		JP	DIFEND
16080	;
16090	DIF33	CP	ISECH
16100		JR	NZ,DIF34
16110		PUSH	DE
16120		POP	IY
16130		CALL	DIFF		;MAKE du
16140		PUSH	IY
16150		PUSH	DE
16160		POP	IY
16170		CALL	COPY		;MAKE u
16180		CALL	MAKE1
16190		PUSH	DE
16200		POP	IY
16210		CALL	COPY
16220		CALL	MAKE2
16230		CALL	BIND2		;MAKE u**2
16240		DEFB	POWER
16250		CALL	BIND2		;MAKE 1-u**2
16260		DEFB	MINUS
16270		CALL	MAKEHF
16280		CALL	BIND2		;MAKE SQR(1-u**2)
16290		DEFB	POWER
16300		CALL	BIND2		;MAKE u*SQR(1-u**2)
16310		DEFB	MULT
16320		CALL	BIND2		;MAKE du/(u*SQR(1-u**2))
16330		DEFB	DIVIDE
16340		CALL	BIND1		;MAKE -du/(u*SQR(1-u**2))
16350		DEFB	NEGATE
16360		POP	IY
16370		JP	DIFEND
16380	;
16390	DIF34	CP	LOG
16400		JR	NZ,DIF35
16410		PUSH	DE
16420		POP	IY		;IY--> u
16430		CALL	DIFF		;MAKE du
16440		PUSH	IY
16450		PUSH	DE
16460		POP	IY		;IY--> u
16470		CALL	COPY
16480		CALL	BIND2		;MAKE du/u
16490		DEFB	DIVIDE
16500		POP	IY
16510		JP	DIFEND
16520	;
16530	DIF35	CP	EXP
16540		JR	NZ,DIF36
16550		PUSH	DE
16560		POP	IY		;IY--> u
16570		CALL	COPY
16580		CALL	BIND1		;MAKE EXP(u)
16590		DEFB	EXP
16600		PUSH	DE
16610		POP	IY		;IY--> u
16620		CALL	DIFF		;MAKE du
16630		PUSH	IY
16640		CALL	BIND2		;MAKE EXP(u) * du
16650		DEFB	MULT
16660		POP	IY
16670		JP	DIFEND
16680	;
16690	DIF36	JP	INERR		;INPUT ERROR
16700	;
16710	DIFEND	POP	IX		;RESTORE REGISTERS
16720		POP	AF
16730		POP	BC
16740		POP	DE
16750		POP	HL
16760		RET
16770	;
16780	;--------------------------------------------------------
16790	;
16800	;SCAN THE INPUTTED STRING AND CONVERT IT INTO
16810	;... A TREE STRUCTURE.
16820	;
16830	PARSE	LD	HL,KBUFF	;HL-->STRING
16840		LD	DE,HSTACK	;HEIRARCHY STACK
16850		XOR	A
16860		LD	(DE),A		;NULL OPERATOR
16870		INC	DE
16880		LD	(DE),A		;LOWEST PRIORITY
16890		INC	DE
16900		LD	C,0		;SET MODE
16910	;
16920	TREE1	PUSH	DE
16930		PUSH	BC
16940		CALL	GETITM		;GET NEXT ITEM
16950		POP	BC
16960		POP	DE
16970		CP	NUMBER
16980		JR	NZ,TREE2	;NOT A NUMBER
16990		CALL	NOT1
17000		CALL	ALOKAT
17010		LD	(IY),NUMBER
17020		LD	A,(4121H)	;COPY THE NUMBER
17030		LD	(IY+1),A
17040		LD	A,(4122H)
17050		LD	(IY+2),A
17060		LD	A,(4123H)
17070		LD	(IY+3),A
17080		LD	A,(4124H)
17090		LD	(IY+4),A
17100		PUSH	IY
17110		LD	C,1		;SET MODE
17120		JR	TREE1
17130	;
17140	TREE2	CP	'a'		;VARIABLE?
17150		JR	C,TREE3
17160		CALL	NOT1		;IS MODE OK?
17170		CALL	ALOKAT
17180		LD	(IY),A
17190		PUSH	IY
17200		LD	C,1
17210		JR	TREE1
17220	;
17230	TREE3	CP	CONPI
17240		JR	NZ,TREE4
17250		CALL	NOT1		;MODE OK?
17260		CALL	ALOKAT
17270		LD	(IY),A		;TYPE=PI
17280		PUSH	IY
17290		LD	C,1
17300		JP	TREE1
17310	;
17320	TREE4	CP	CONSTE
17330		JR	NZ,TREE5
17340		CALL	NOT1
17350		CALL	ALOKAT
17360		LD	(IY),A		;TYPE= e
17370		PUSH	IY
17380		LD	C,1
17390		JP	TREE1
17400	;
17410	TREE5	CP	RPAREN
17420		JR	NZ,TREE6
17430		JR	TREE8
17440	TREE12	DEC	DE		;GET LAST FUNCTION
17450		DEC	DE
17460		LD	A,(DE)
17470		CP	POWER+1		;NOT A MATCHING '('?
17480		JP	C,INERR
17490		CP	LPAREN
17500		JP	Z,TREE14	;WAS A '('
17510		CALL	ALOKAT
17520		LD	(IY),A		;SAVE FUNCTION
17530		POP	IX		;GET OPERAND
17540		CALL	LINK1
17550		PUSH	IY
17560	TREE14	LD	C,1		;SET MODE
17570		JP	TREE1
17580	;
17590	TREE6	CP	MINUS		;UNARY MINUS?
17600		JR	NZ,TREE7
17610		LD	B,A
17620		LD	A,C		;CHECK MODE
17630		OR	A
17640		LD	A,B
17650		JR	NZ,TREE7
17660		CALL	ALOKAT		;MAKE IT A 0-u
17670		LD	(IY),NUMBER
17680		LD	(IY+4),0	;ZERO
17690		PUSH	IY
17700		LD	A,MINUS
17710		LD	C,1
17720	;
17730	TREE7	CP	POWER+1		;FUNCTION?
17740		JR	C,TREE8
17750		CALL	NOT1
17760		LD	(DE),A		;SAVE FUNCTION
17770		INC	DE
17780		LD	A,1		;LOWEST PRIORITY
17790		LD	(DE),A
17800		INC	DE
17810		LD	C,0		;SET MODE
17820		JP	TREE1
17830	;
17840	TREE8	PUSH	AF
17850		LD	A,C
17860		OR	A
17870		JP	Z,INERR
17880		POP	AF
17890		LD	B,4		;SET PRIORITY
17900		CP	POWER
17910		JR	Z,TREE9
17920		LD	B,3
17930		CP	MULT
17940		JR	Z,TREE9
17950		CP	DIVIDE
17960		JR	Z,TREE9
17970		LD	B,2
17980	;
17990	TREE9	DEC	DE		;GET LAST PRIORITY
18000		PUSH	AF
18010		LD	A,(DE)
18020		CP	B
18030		JR	NC,TREE10
18040		INC	DE		;STACK THE OPERATOR
18050		POP	AF
18060		OR	A
18070		JR	Z,TREE11	;END OF INPUT?
18080		CP	RPAREN
18090		JR	Z,TREE12	;END OF PARENTHESES?
18100		LD	(DE),A
18110		INC	DE
18120		LD	A,B
18130		LD	(DE),A		;STACK THE PRIORITY
18140		INC	DE
18150		LD	C,0
18160		JP	TREE1
18170	;
18180	TREE10	POP	AF		;GET NEWEST FROM STRING
18190		LD	C,A		;SAVE IT FOR NOW
18200		DEC	DE
18210		LD	A,(DE)		;GET OPERATOR
18220		CALL	ALOKAT
18230		LD	(IY),A		;SAVE OPERATOR
18240		POP	IX		;IX-->LAST OPERAND
18250		CALL	LINK2
18260		POP	IX		;IX-->EARLIER OPERAND
18270		CALL	LINK1
18280		PUSH	IY
18290		LD	A,C
18300		LD	C,1
18310		JP	TREE9
18320	;
18330	TREE11	DEC	DE		;MAKE SURE STACK IS EMPTY
18340		LD	A,(DE)
18350		OR	A
18360		JP	NZ,INERR
18370		POP	IY
18380		RET
18390	;
18400	;--------------------------------------------------------
18410	;
18420	;MAKE SURE MODE (C) IS NOT 1
18430	;
18440	NOT1	PUSH	AF
18450		LD	A,C
18460		OR	A
18470		JP	NZ,INERR
18480		POP	AF
18490		RET
18500	;
18510	;--------------------------------------------------------
18520	;
18530	REDUCE	RET			;IN CASE "REDUCE" IS NOT LINKED
18540	FREMEM	EQU	$
18550		END	START