move.l #2$,d0
	bsr Install_Error

	bsr Open_DOS_Server

	move.l #10$,d1
	bsr Open_File_Old
	bsr Copy_File_To_Ring
	bsr Close_File

	bsr Reset_RingServer
	bsr Open_SymbolsServer
	bsr Open_BracketStack
	bsr Open_VarSymb_Stack
	bsr Reset_TermRing
	bsr Execute_SourceCode

	clr.l d0
	bra Break
2$					;--- close all ---

	bsr Reset_TermRing
	bsr Close_VarSymb_Stack
	bsr Close_BracketStack
	bsr Close_SymbolsServer
	bsr Reset_RingServer

	bsr Close_DOS_Server
	nop
	nop
	nop
	nop
	rts

10$	dc.b "df1:term",0
	even

;===============;
;  error-codes  ;
;===============;

EC_BrackStackOverfl	= 1	;bracket-stack-overflow
EC_BrackSTackUnderfl	= 2	;bracket-stack-underflow
EC_IllegalChar		= 3	;illegal char
EC_IllegalNumb		= 4	;illegal number
EC_IllegalVSymb		= 5	;illegal var-symbol


********************************************************
*                                                      *
*    E  R  R  O  R  -  C  O  N  T  R  O  L  L  E  R    *
*                                                      *
********************************************************

Error_Table	ds.l 4		;error-table

Install_Error
**********************************
*  install error-mark for break  *
**********************************
;d0,break-addr
;_a0,used

	move.l a7,Error_Table	;set stack in error-table
	move.l (a7)+,a0		;save return-jump-addr
	move.l d0,-(a7)		;push break-addr
	jmp (a0)		;leave

Break
********************
*  break on error  *
********************
;d0,error-code
;_d0,error-code

	move.l Error_Table(pc),a7  ;get saved stack from error-table
	rts


*****************************************************
*                                                   *
*    A  L  G  E  B  R  A  I  C     L  O  G  I  C    *
*                                                   *
*****************************************************

;=================;
;  bracket-stack  ;
;=================;

Size_BracketStack	= 200	;max. number of entries in bracket-stack
BracketStack		dc.l 0	;bracket-stack

;==========================================;
;  identifications for list of logic-term  ;
;==========================================;

LI_OpenBrack	= $0000		;open bracket * futile! do not modify *
LI_CloseBrack	= $0002		;close bracket * futile! do not modify *
LI_Nil		= $0006		;nil
LI_One		= $0007		;one
LI_VSymb	= $0008		;variable-symbols


Add_OpenBracket
********************************
*  add "open bracket" to term  *
********************************
;a1,term-ring (0 ==> bracket-list will not be added)
;_a1,term-ring: bracket-list

	movem.l d0/a0,-(a7)
	moveq #6,d0		;6 bytes
	bsr Add_New_List	;install bracket-list and add to term
	move.w #LI_OpenBrack,8(a0)  ;set identity of "opn brkt" in list
	bsr Push_Bracket	;push bracket-list on bracket-stack
	move.l a0,a1		;get bracket-list
	movem.l (a7)+,d0/a0
	rts

Add_CloseBracket
*********************************
*  add "close bracket" to term  *
*********************************
;a1,term-ring (0 ==> bracket-list will not be added)
;_a1,term-ring: bracket-list

	movem.l d0/a0,-(a7)
	moveq #2,d0		;2 bytes
	bsr Add_New_List	;install bracket-list and add to term
	move.l a0,a1		;get bracket-list
	move.w #LI_CloseBrack,8(a1)  ;set identity of "clos brkt" in list
	bsr Pop_Bracket		;pop bracket-list from bracket-stack
	move.l a1,10(a0)	;set "close brkt"-list in "open brkt"-list
	movem.l (a7)+,d0/a0
	rts

Close_Remain_Brack
******************************
*  close remaining brackets  *
******************************
;a1,term-ring (0 ==> no closing)
;_a1,term-ring: last added bracket-list

	movem.l d0-d1/a2,-(a7)
	move.l BracketStack(pc),a2  ;get bracket-stack
	bsr Test_QuickStack	;get stack-pointer
	bra.s 1$		;start closing
2$	bsr Add_CloseBracket	;add "close bracket" to term
1$	subq.l #4,d1		;dec counter for stack-pointer
	bpl.s 2$		;bracket-stack is empty? =no
	movem.l (a7)+,d0-d1/a2
	rts

Bracket_TermList
*******************************
*  put term-list in brackets  *
*******************************
;a1,term-list (0 ==> term-list will not be put in brackets)
;ZF,0 <==> set and-flag
;_a1,term-ring: added close-bracket-list

	movem.w d0,-(a7)
	move sr,d0		;save and-flag
	move.l a1,-4(a7)	;term-list exists?
	beq.s 1$		;=no
	move.l -(a1),a1		;get previous term-list
	bsr Add_OpenBracket	;open bracket
	btst #2,d0		;and-flag set?
	bne.s 2$		;=no
	bchg #2,9(a1)		;set and-flag in open-bracket-list
2$	move.l (a1),a1		;get next term-list
	bsr Add_CloseBracket	;close bracket
1$	move.w (a7)+,d0
	rts

Push_Bracket
****************************************
*  push bracket-list on bracket-stack  *
****************************************
;a0,bracket-list

	move.l a2,-(a7)
	move.l BracketStack(pc),a2  ;get bracket-stack
	bsr Push_QuickStack	;push bracket-list on stack
	bne.s 1$		;stack-overflow? =no
	moveq #EC_BrackStackOverfl,d0  ;error-code: bracket-stack-overflow
	bra Break		;break
1$	move.l (a7)+,a2
	rts

Pop_Bracket
*****************************************
*  pop bracket-list from bracket-stack  *
*****************************************
;_a0,bracket-list

	move.l a2,-(a7)
	move.l BracketStack(pc),a2  ;get bracket-stack
	bsr Pop_QuickStack	;pop bracket-list from stack
	bne.s 1$		;stack-underflow? =no
	moveq #EC_BrackStackUnderfl,d0 ;error-code: brack-stack-underflow
	bra Break		;break
1$	move.l (a7)+,a2
	rts

Open_BracketStack
************************
*  open bracket-stack  *
************************

	movem.l d0/a0,-(a7)
	move.l BracketStack(pc),a0	;get old bracket-stack
	move.l #Size_BracketStack*4,d0	;get size of bracket-stack
	bsr Open_QuickStack		;open bracket-stack
	move.l a0,BracketStack		;save bracket-stack
	movem.l (a7)+,d0/a0
	rts

Close_BracketStack
*************************
*  close bracket-stack  *
*************************

	move.l a0,-(a7)
	move.l BracketStack(pc),a0	;get bracket-stack
	bsr Close_QuickStack		;close bracket-stack
	move.l a0,BracketStack		;save closed bracket-stack
	move.l (a7)+,a0
	rts

Add_Term
**********************
*  add term to term  *
**********************
;a1,term-ring: main-term (0 ==> no adding)
;a0,term-ring: term, that should be added
;_a1,last list of added term

	move.l a1,-4(a7)	;main-term does exist?
	beq.s 1$		;=no
	move.l (a1),a1		;get next list of main-term
	bsr Add_Ring		;add term to main-term
	move.l -(a1),a1		;get last list of added term
	rts
1$	move.l a0,a1		;main-term:= term
	rts

Add_New_TermList
*******************************
*  add new term-list to term  *
*******************************
;a1,term-ring: main-term (0 ==> no adding)
;a0,term-list
;_a1,last list of added term

	exg a0,a1		;get term-list
	bsr Sort_TermList	;sort term-list
	bsr Shorten_TermList	;shorten term-list
	exg a0,a1		;get term-ring
	bne.s Add_Term		;term-list was deleted? =no
	rts

Install_OneList
****************************************
*  install term-list with logical one  *
****************************************
;_a0,term-list containing logical one

	move.l d0,-(a7)
	moveq #2,d0		;list-size:= 2
	bsr Install_List	;install list for logical one
	move.w #LI_One,8(a0)	;set one-mark in list
	move.l (a7)+,d0
	rts

Test_TermList
********************
*  test term-list  *
********************
;a1,term-list
;_CF,0 <==> term-list = var-symbols-list
;_CF,1 <==> term-list = bracket-list
;_ZF,1 <==> open bracket, 0 <==> close bracket

	cmp.w #LI_VSymb,8(a1)	;set flag: term-list = var-symbols-list?
	btst #1,8(a1)		;set bracket-flag: open/close?
	rts

Set_AndFlag
******************************************
*  set logical and-flag in bracket-list  *
******************************************
;a1,bracket-list

	or.w #4,8(a1)		;set logical and-flag in list-block
	rts

Eliminate_Brack
****************************
*  eliminate all brackets  *
****************************
;a0,term-ring (0 ==> no elimination)
;_a0,term-ring (does not contain brackets) (0 <== term-ring was deleted)

	movem.l d0/a1/a3-a4,-(a7)
	move.l a0,d0		;term-ring exists?
	beq.s 12$		;=no
	moveq #2,d0		;list-size:= 2
	bsr Install_List_Set	;install end-list
	move.w #LI_VSymb,8(a1)	;mark end-list
	bsr Add_Ring		;add end-list to term-ring
	move.l a0,a3		;get term-ring
				;--- install mem for queue-savings ---
	move.l #Size_BracketStack*4,d0  ;get size of bracket-stack
	bsr Alloc_Mem		;alloc mem for queue-savings
	move.l a0,a4		;get mem of queue-savings
	clr.l (a4)		;set "no bracket-queue saved"
				;--- check term-lists ---
2$	cmp.w #LI_VSymb,8(a3)	;term-list = bracket-list?
	blo.s 1$		;=yes
3$	move.l (a3),a3		;get next term-list
	cmp.l a3,a1		;end of term-ring?
	bne.s 2$		;=no
				;--- end ---
	bsr 10$			;multiply saved bracket-queue
	move.l #Size_BracketStack*4,d0  ;get size of bracket-stack
	move.l a4,a0		;get mem of queue-savings
	bsr Free_Mem		;free mem of queue-savings
	move.l a1,a0		;get added end-list of term-ring
	bsr Delete_List		;delete empty list and get term-ring
12$	movem.l (a7)+,d0/a1/a3-a4
11$	rts
				;--- bracket-list found ---
1$	btst #1,9(a3)		;list = close-bracket-list?
	bne.s 4$		;=yes
				;--- open-bracket-list ---
	move.l a3,a0		;get open-bracket-list
	bsr Push_Bracket	;push open-bracket-list on bracket-stack
	btst #2,9(a3)		;and-flag of bracket-list set?
	beq.s 6$		;=no
	bsr 10$			;multiply saved bracket-queue
	move.l a3,(a4)		;save open-bracket-list (=bracket-queue)
6$	addq.l #4,a4		;inc queue-savings-pointer
	clr.l (a4)		;set "no bracket-queue saved"
	bra.s 3$		;next term-list
4$				;--- close-bracket-list ---
	bsr 10$			;multiply pushed bracket-queue
	bsr Pop_Bracket		;pop open-bracket-list from bracket-stack
	bclr #0,9(a0)		;negation-flag of bracket-list set?
	beq.s 5$		;=no
	bsr Negate_BrackTerm	;negate bracket-term
5$	subq.l #4,a4		;dec queue-savings-pointer
	bra.s 3$		;next term-list
10$				;--- multiply saved bracket-queue ---
	tst.l (a4)		;bracket-queue saved?
	beq.s 11$		;=no
	move.l (a4),a0		;get bracket-queue
	bra Multiply_BrackQueue	;multiply bracket-queue

Negate_BrackTerm
*************************
*  negate bracket-term  *
*************************
;a0,open-bracket-list
* bracket-term must not contain brackets *

	movem.l a0-a2,-(a7)
	bsr Remove_BrackTerm	;remove bracket-term
	move.l a1,a2		;save close-bracket-list
	bne.s 2$		;bracket-term is empty? =no
	bsr Install_OneList	;install list with logical one
	bra.s 3$		;insert list in brackets
2$	bsr Negate_Term		;negate removed term-ring
	beq.s 1$		;new term-ring was deleted? =yes
3$	move.l a2,a1		;get close-bracket-list
	bsr Add_Ring		;insert new term-ring in brackets
1$	movem.l (a7)+,a0-a2
	rts

Negate_Term
**********************
*  negate term-ring  *
**********************
;a0,term-ring (must not contain brackets)
;_a0,negated term-ring (0 <== term-ring was deleted)
;_ZF,1 <==> term-ring was deleted

	movem.l d0/a1-a3,-(a7)
	move.l a0,d0		;save first list of term-ring
	move.l a0,a2		;save term-ring
	move.l #0,a1		;set "there is no new term-ring"
1$	bsr Add_OpenBracket	;add open-bracket to new term-ring
	move.l a1,a3		;save new term-ring
	move.l (a2),a0		;get current term-list of term-ring
	bsr Negate_TermList	;negate term-list
	move.l a1,a0		;get ring of negated term
	move.l a3,a1		;get new term-ring
	bsr Add_Term		;add ring of negated term to new term-ring
	bsr Add_CloseBracket	;add close-bracket to new term-ring
	move.l (a2),a2		;get next list of term-ring
	cmp.l a2,d0		;end of term-ring?
	bne.s 1$		;=no
	move.l a2,a0		;get term-ring
	bsr Delete_Ring		;delete term-ring
	move.l (a1),a0		;get new term-ring
	bsr Multiply_BrTe_Ring	;multiply bracket-terms of new term-ring
	movem.l (a7)+,d0/a1-a3
	rts

Negate_TermList
**********************
*  negate term-list  *
**********************
;a0,term-list
;_a1,term-list

	movem.l d0-d2/a0/a2,-(a7)
	move.l #0,a1		;set "there is no term-ring"
	move.l a0,a2		;save term-list
	addq.l #4,a2		;get block and block-size of term-list
	move.l (a2)+,d2
	moveq #2,d0		;block-size for new var-symb-lists:= 2
1$	move.w (a2)+,d1		;get var-symbol of term-list
	bchg #0,d1		;invert negation-flag of var-symbol
	bsr Add_New_List	;add new list for var-symbol to term-ring
	move.w d1,8(a0)		;set var-symbol in new list
	move.l a0,a1		;get term-ring
	subq.l #2,d2		;dec block-size of term-list
	bne.s 1$		;all var-symbols negated? =no
	move.l (a1),a1		;get term-ring
	movem.l (a7)+,d0-d2/a0/a2
	rts

Multiply_BrackQueue
****************************
*  multiply bracket-queue  *
****************************
;a0,open-bracket-list of first bracket-term
;_a0,first term-list of multiplied bracket-queue
;_a0,0 <== bracket-queue was deleted
* bracket-terms must not contain brackets *

	movem.l d0/a1,-(a7)
	move.l a0,a1		;get first open-bracket-list
1$	move.l 10(a1),a1	;get close-bracket-list
	move.l (a1),a1		;get next list
	cmp.w #2,8(a1)		;list = open-bracket-list without and-flag?
	blo.s 1$		;=yes
	bsr Remove_Ring		;remove bracket-queue
	move sr,d0		;save status "no term-ring remained?"
	bsr Multiply_BrTe_Ring	;multiply removed bracket-queue
	beq.s 2$		;bracket-queue was deleted? =yes
	btst #2,d0		;no term-ring remained?
	bne.s 2$		;=yes
	bsr Add_Ring		;insert multiplied queue in term-ring
2$	movem.l (a7)+,d0/a1
	rts

Multiply_BrTe_Ring
***********************************
*  multiply bracket-terms of ring *
***********************************
;a0,bracket-terms-ring
;_a0,term-ring (does not contain brackets) (0 <== term-ring was deleted)
;_ZF,1 <==> term-ring was deleted
* ring is only allowed to contain bracket-terms *
* bracket-terms must not contain brackets *

	move.l d0,-(a7)
	bra.s 2$		;start multiplying
1$	bsr Multiply_BrackTerms	;multiply two bracket-terms
	move.l 10(a0),a0	;get close-bracket-list of new bracket-term
	move.l (a0),a0		;get next bracket-term
2$	move.l 10(a0),d0	;get close-bracket-list
	cmp.l -4(a0),d0		;ring exists of one bracket-term?
	bne.s 1$		;=no
	move.l -(a0),a0		;get close-bracket-list
	bsr Delete_List		;delete close-bracket-list
	bsr Delete_List		;delete open-bracket-list
	move.l a0,-4(a7)	;get status of term-ring
	movem.l (a7)+,d0
	rts

Multiply_BrackTerms
*************************************
*  multiply adjacent bracket-terms  *
*************************************
;a0,open-bracket-list of first bracket-term
;_order: a0-bracket-term * next term of a0-bracket-term
* bracket-terms must not contain brackets *

	movem.l d0/a0-a3,-(a7)
				;--- remove bracket-terms ---
	bsr Remove_BrackTerm	;remove bracket-term 1
	move sr,-(a7)		;save status of term 1
	move.l a0,a3		;save term-ring 1
	move.l (a1),a0		;get open-bracket-list of term 2
	bsr Remove_BrackTerm	;remove bracket-term 2
	move sr,d0		;save status of term 2
	exg.l a0,a1		;save term-ring 2
	move.l -(a0),a0		;get open-bracket-list of term 2
	bsr Delete_List		;delete open-bracket-list of term 2
	bsr Delete_List		;delete close-bracket-list of term 2
	exg a0,a3		;get term-ring 1
				;--- test bracket-terms ---
	or.w (a7)+,d0		;status: term 1 or term 2
	eor.b #4,d0		;change status-bit
	btst #2,d0		;term 1 or term 2 is empty?
	beq.s 2$		;=yes
				;--- multiply bracket-terms ---
	bsr Multiply_Terms	;multiply term-ring 1 with term-ring 2
2$	move sr,-(a7)		;save status of new term-ring
	bsr Delete_Ring		;delete term-ring 1
	move.l a1,a0		;get term-ring 2
	bsr Delete_Ring		;delete term-ring 2
	move (a7)+,ccr		;get status of new term-ring
	beq.s 1$		;new term-ring was deleted? =yes
	move.l a2,a0		;get new term-ring
	bsr Shorten_Term	;shorten new term-ring
	move.l -(a3),a1		;get close-bracket-list of term 1
	bsr Add_Ring		;insert new term-ring in remained brackets
1$	movem.l (a7)+,d0/a0-a3
	rts

Multiply_Terms
*****************************
*  multiply two term-rings  *
*****************************
;a0,term-ring 1 (must not contain brackets)
;a1,term-ring 2 (must not contain brackets)
;_a2,term-ring of multiplied terms
;_ZF,1 <==> new term-ring does not exist

	movem.l d0-d1/a0-a1/a3-a4,-(a7)
	cmp.w #LI_One,8(a0)	;term 1 = logical one?
	beq.s 3$		;=yes
	cmp.w #LI_One,8(a1)	;term 2 = logical one?
	beq.s 4$		;=yes
	move.l a0,d0		;save first list of term-ring 1
	move.l a1,d1		;save first list of term-ring 2
	move.l a0,a3		;save term-ring 1
	move.l a1,a4		;save term-ring 2
	move.l #0,a1		;set "there is no new term-ring"
				;--- make new term-ring ---
2$	exg a0,a3		;get term-list 1
	exg a1,a4		;get term-list 2
	bsr Multiply_TermLists	;multiply current term-lists
	exg a0,a3		;save term-list 1
	exg a1,a4		;save term-list 2
	beq.s 1$		;new term-list was deleted? =yes
	move.l a2,a0		;get new term-list
	bsr Add_List		;add new term-list to new term-ring
	move.l a0,a1		;get new term-ring
1$	move.l (a3),a3		;get next list of term-ring 1
	cmp.l a3,d0		;end of term-ring 1?
	bne.s 2$		;=no
	move.l (a4),a4		;get next list of term-ring 2
	cmp.l a4,d1		;end of term-ring 2?
	bne.s 2$		;=no
				;--- end ---
	move.l (a1),a2		;get new term-ring
5$	move.l a1,d0		;set status "new term-ring exists?"
	movem.l (a7)+,d0-d1/a0-a1/a3-a4
	rts
				;--- term-ring = logical one ---
3$	move.l a1,a0		;get term-ring 2
4$	bsr Duplicate_Ring	;duplicate term-ring
	move.l a1,a2		;get new term-ring
	bra.s 5$		;end


Multiply_TermLists
*****************************
*  multiply two term-lists  *
*****************************
;a0,term-list 1
;a1,term-list 2
;_a2,list of multiplied term
;_ZF,1 <==> new term-list was deleted

	movem.l d0-d2/a0-a1/a3,-(a7)
	move.l a0,a2		;get term-list 2
	addq.l #4,a2		;get block and block-size of term-list 1
	move.l (a2)+,d2
	addq.l #4,a1		;get block and block-size of term-list 2
	move.l (a1)+,d1
	move.l d1,d0		;size of new term-list:=
	add.l d2,d0		;block-size 1 + block-size 2
	bsr Install_List	;install list for multiplied term
	lea.l 8(a0),a3		;get list-block of new term-list
				;--- multiplication ---
3$	move.w (a2),d0		;get var-symb 1
	cmp.w (a1),d0		;var-symb 1 = var-symb 2
	beq.s 1$		;=yes
	blo.s 2$		;var-symb 1 < var-symb 2? =yes
				;- var-symb 1 > var-symb 2 -
	move.w (a1)+,(a3)+	;copy var-symb 2 into new term-list
	subq.l #2,d1		;dec counter 2
	bne.s 3$		;end of term-list 1? =no
5$	move.w (a2)+,(a3)+	;copy var-symb 1 into new term-list
	subq.l #2,d2		;dec counter 1
	bne.s 5$		;end of term-list 2? =no
	bra.s 7$
2$				;- var-symb 1 < var-symb 2 -
	move.w (a2)+,(a3)+	;copy var-symb 1 into new term-list
	subq.l #2,d2		;dec counter 1
	bne.s 3$		;end of term-list 1? =no
6$	move.w (a1)+,(a3)+	;copy var-symb 2 into new term-list
	subq.l #2,d1		;dec counter 2
	bne.s 6$		;end of term-list 2? =no
	bra.s 7$
1$				;- var-symb 1 = var-symb 2 -
	addq.l #2,a1		;skip var-symb 2
	subq.l #2,d1		;dec counter 2
	bne.s 2$		;end of term-list 2? =no
	bra.s 5$		;copy remaining term 1 into new term-list
7$				;--- delete end of new term-list ---
	move.l 4(a0),d0		;end-size:= block-size of new term-list
	add.l a0,d0		;+ new term-list
	sub.l a3,d0		;- pointer of new term-list
	addq.l #8,d0		;+ 8
	beq.s 8$		;end-size = 0? =yes
	bsr Delete_ListEnd	;delete end of new term-list
8$				;--- test term-list concerning nil ---
	lea.l 8(a0),a1		;get block of new term-list
	move.l 4(a0),d1		;counter:= block-size of new term-list
	subq.l #2,d1		;dec counter
10$	subq.l #2,d1		;dec counter
	bmi.s 11$		;all var-symbols checked? =yes
	move.w (a1)+,d0		;get var-symb
	bset #0,d0		;var-symb is negated? and set negation-flag
	bne.s 10$		;=yes
	cmp.w (a1),d0		;var-symb = next var-symb?
	bne.s 10$		;=no
	bsr Delete_List		;delete new term-list
11$				;--- end ---
	move.l a0,a2		;get new term-list
	move.l a2,d0		;set "new term-list was deleted?"
	movem.l (a7)+,d0-d2/a0-a1/a3
	rts

* some old code *
	movem.l a0-a1,-(a7)
	move.l a1,a2		;save term-list 2
	bsr Duplicate_List	;duplicate term-list 1
	move.l a2,a0		;get term-list 2
	move.l a1,a2		;save duplicated term-list 1
	bsr Duplicate_List	;duplicate term-list 2
	move.l a2,a0		;get duplicated term-list 1
	bsr Add_List		;link duplicated term-list 1 and 2
	bsr Fuse_Ring		;fuse new term-ring to list
	move.l a0,a1		;get new term-list
	bsr Sort_TermList	;sort new term-list
	bsr Shorten_TermList	;shorten new term-list
	move.l a1,a2		;get new term-list
	movem.l (a7)+,a0-a1
	rts

Remove_BrackTerm
***************************************
*  remove bracket-term from brackets  *
***************************************
;a0,open-bracket-list
;_a0,removed bracket-term (0 <== bracket-term is empty)
;_a1,close-bracket-list
;_ZF,1 <==> bracket-term is empty

	move.l 10(a0),a1	;end-list:= close-bracket-list
	move.l (a0),a0		;get first term-list
	bsr Remove_Ring		;remove term
	bne.s 1$		;term is empty? =no
	move.l #0,a0		;set "there is no term-ring"
1$	rts

Shorten_Term
***********************
*  shorten term-ring  *
***********************
;a0,term-ring (must not contain brackets)
;_a0,shortened term-ring

	movem.l d0-d4/a1-a3,-(a7)
	bra.s 2$		;start stortening
9$				;--- compare two term-lists ---
	clr.b d4		;set flag "delete 2"
	lea.l 8(a0),a2		;get list-block of pointer 1
	lea.l 8(a1),a3		;get list-block of pointer 2
	move.l 4(a0),d2		;counter 1:= list-block-size of pointer 1
	move.l 4(a1),d3		;counter 2:= list-block-size of pointer 2
	cmp.l d2,d3		;block-size 1 = block-size 2?
	beq.s 3$		;=yes
	bhi.s 7$		;block-size 2 > block-size 1? =yes
	moveq #1,d4		;set flag "delete 1"
	exg a2,a3		;exchange 1 with 2
	exg d2,d3
				;- test: 2 contains 1 -
7$	move.w (a2)+,d0		;get var-symb 1
8$	cmp.w (a3)+,d0		;var-symb 1 < var-symb 2?
	blo.s 5$		;=yes
	bne.s 4$		;var-symb 1 = var-symb 2? =no
	subq.l #2,d2		;dec counter 1
	beq.s 6$		;2 contains 1? =yes
	subq.l #2,d3		;dec counter 2
	bne.s 7$		;2 does not contain 1? =no
	bra.s 5$		;=yes
4$	subq.l #2,d3		;dec counter 2
	bne.s 8$		;2 does not contain 1? =no
	bra.s 5$		;=yes
				;- test: 1 equal 2 -
3$	cmp.w (a2)+,(a3)+	;var-symb 1 = var-symb 2?
	bne.s 17$		;=no
	subq.l #2,d2		;dec counter 1
	bne.s 3$		;all var-symbols compared? =no
6$				;--- delete list ---
	btst #0,d4		;flag is "delete 2"?
	beq.s 10$		;=yes
	cmp.l a0,d1		;deleting first list of term-ring?
	bne.s 13$		;=no
	bsr Delete_List		;delete list of pointer 1
2$	move.l a0,d1		;term-ring-start:= first list of pointer 1
	move.l (a0),a1		;pointer 2:= next list of pointer 1
	bra.s 12$		;new pointers
13$	bsr Delete_List		;delete list of pointer 1
	bra.s 11$		;new pointer 1
10$	exg a0,a1		;get pointer 2
	bsr Delete_List		;delete list of pointer 2
	exg a0,a1		;get pointer 1
	bra.s 12$		;new pointer 2
5$				;--- inc pointers ---
	move.l (a1),a1		;inc pointer 2
12$	cmp.l a1,d1		;pointer 2 = term-ring-start?
	bne.s 9$		;=no
	move.l (a0),a0		;inc pointer 1
11$	move.l (a0),a1		;pointer 2:= next list of pointer 1
	cmp.w #LI_One,8(a0)	;term of pointer 1 = logical one?
	beq.s 15$		;=yes
	cmp.l a0,d1		;pointer 1 = term-ring-start?
	bne.s 12$		;=no
16$	movem.l (a7)+,d0-d4/a1-a3
	rts
15$				;--- logical one found ---
	bsr Duplicate_List	;duplicate term-list of logical one
	bsr Delete_Ring		;delete term-ring
	move.l a1,a0		;term-ring:= list of logical one
	bra.s 16$		;end
17$				;--- test: 1 = 2 but one v-symb negated ---
	bra.s 5$
	move.w -4(a2),d0	;get var-symb 1
	bset #0,d0		;set negation-flag of var-symb 1
	sub.w -4(a3),d0		;var-symb 1 - var-symb 2
	cmp.w #1,d0		;var-symb 1 = var-symb 2?
	bhi.s 5$		;=no
	bra.s 19$		;compare remained var-symbols
18$	cmp.w (a2)+,(a3)+	;var-symb 1 = var-symb 2?
	bne.s 5$		;=no
19$	subq.l #2,d2		;dec counter 1
	bne.s 18$		;all var-symbols compared? =no
	


Sort_TermList
********************
*  sort term-list  *
********************
;a1,term-list

	movem.l d0-d2/a1-a3,-(a7)
	addq.l #4,a1		;get size of list-block and lo-pointer
	move.l (a1)+,d1
	lea.l (a1,d1.l),a2	;get hi-pointer
	bsr 100$		;sort elements of list
	movem.l (a7)+,d0-d2/a1-a3
1$	rts
100$				;---  r e c u r r e n t   p a r t  ---
	move.l a2,d1		;get hi-pointer
	sub.l a1,d1		;number of elements:= hi - lo
	cmp.l #2,d1		;number of elements <= 1?
	bls.s 1$		;=yes
	movem.l a1-a2,-(a7)	;save hi-pointer and lo-pointer
				;--- random test ---
	move.w (a1),d0		;comparing element:= first element
	move.l a1,a3		;save addr of comparing element
				;--- sort ---
4$	cmp.w (a1)+,d0		;compare element of lo-pointer
	bhs.s 6$		;element <= comparing element? =yes
	move.w -(a2),d2		;save element of hi-pointer
	move.w -(a1),(a2)	;set element of lo-pointer to hi-pointer
	move.w d2,(a1)		;set element of hi-pointer to lo-pointer
6$	subq.l #2,d1		;dec elements-counter
	bne.s 4$		;end? =no
	move.w -(a1),d2		;get uppest element of lo-part
	move.w d0,(a1)		;set comparing element into middle
	move.w d2,(a3)		;set uppest ele into place of old comp ele
				;--- split into lo-part & hi-part ---
	move.l a1,a2		;get middle-pointer
	move.l (a7)+,a1		;get saved lo-pointer
	bsr.s 100$		;sort lo-part
	lea.l 2(a2),a1		;middle-pointer + 2 (place of comp ele)
	move.l (a7)+,a2		;get saved hi-pointer
	bra.s 100$		;sort hi-part

Shorten_TermList
***********************
*  shorten term-list  *
***********************
;a1,term-list
;_ZF,0 <==> term-list was not deleted ==> _a1,term-list
;_ZF,1 <==> term-list was deleted ==> _a1,next list of term-list

	movem.l d0-d2/a0/a2,-(a7)
	move.l 4(a1),d0		;symbol-counter:= size of list-block
	beq.s 8$		;empty list? =yes
	lea.l 8(a1),a0		;get block-addr of list
	clr.l d2		;short-counter:= 0
				;--- check symbols ---
2$	move.w (a0)+,d1		;get symbol
4$	subq.l #2,d0		;dec symbol-counter
	beq.s 1$		;all symbols checked? =yes
	cmp.w (a0),d1		;symbol = previous symbol?
	bne.s 3$		;=no
	addq.l #2,d2		;short-counter + 2
	clr.w (a0)+		;mark symbol for deleting
	bra.s 4$		;check next symbol
3$	or.b #1,d1		;set negative-flag of previous symbol
	cmp.w (a0),d1		;symbol = previous symbol?
	bne.s 2$		;=no
8$				;--- term = 0 ---
	move.l a1,a0		;get list
	bsr Delete_List		;delete term-list
	move.l a0,a1		;get next list of deleted list
	or #4,ccr		;set flag "term-list was deleted"
	bra.s 7$		;end
1$				;--- shorten term ---
	tst.b d2		;there is something to shorten?
	beq.s 9$		;=no
	lea.l 8(a1),a0		;get list-block
	move.l a0,a2		;get list-block
	move.l 4(a1),d0		;get list-block-size
6$	move.w (a0)+,d1		;get symbol
	beq.s 5$		;symbol was shortened? =yes
	move.w d1,(a2)+		;set symbol into list
5$	subq.l #2,d0		;list-block-size - 2
	bne.s 6$		;end? =no
	move.l a1,a0		;get list
	move.l d2,d0		;get size of shortened mem
	bsr Delete_ListEnd	;delete end of list
9$	and #-4-1,ccr		;set flag "term-list was not deleted"
7$	movem.l (a7)+,d0-d2/a0/a2
	rts

Decode_Term
***************************
*  decode term into text  *
***************************
;a1,term-ring (0 ==> no decoding)
;a2,data-manager for symbols
;_a0,text-ring
;_a0,0 <== there was no term-ring

	movem.l d0-d3/a3-a5,-(a7)
	move.l #0,a0		;set "there is no text-ring"
	move.l a1,d1		;term-ring exists?
	beq.s 30$		;=no
	bsr Open_Stack		;open stack-ring for text
	move.l a0,a4		;save stack-ring
	move.l a1,d1		;save first list of term-ring
	lea.l 33$(pc),a3	;get addr of symbol-code for data-manager
9$				;--- check term-list ---
	lea.l 8(a1),a5		;get block of term-list
	cmp.w #LI_VSymb,(a5)	;term-list = bracket-list?
	bhs.s 17$		;=no
	blo.s 2$		;=yes
8$	move.l (a1),a1		;get next term-list
	cmp.l a1,d1		;end of term-ring?
	bne.s 9$		;=no
	move.l a4,a0		;get text-ring
30$	movem.l (a7)+,d0-d3/a3-a5
	rts
17$				;--- term-list is symbols-list ---
	move.l 4(a1),d2		;get block-size of term-list
	bsr.s 22$		;write "logical and" into text
6$	move.w (a5)+,d3		;get code
	lsr.w #1,d3		;get symbol-code and negation-flag
	bcc.s 1$		;negation-flag set? =no
	bsr.s 10$		;write negation into text
1$	move.w d3,3$		;save symbol-code
	moveq #6,d0		;symbol-code-size:= 2
	bsr Search_Date		;search symbol-code in data-manager
	beq.s 4$		;symbol found? =yes
	lea.l 5$(pc),a0		;get text for unknown symbol
4$	move.l (a0),a0		;get text-list of symbol
	addq.l #4,a0		;get block and block-size of text-list
	move.l (a0)+,d0
	bsr.s 20$		;write symbol-text into text
	bsr.s 11$		;write {space} into text
	subq.l #2,d2		;block-size - 2
	bne.s 6$		;list-end? =no
	bra.s 8$		;next term-list
	dc.l 5$			;text-list for unknown symbol
5$	dc.l 5$,1
	dc.b "?",0
33$	dc.w 0,0		;symbol-code for data-manager
3$	dc.w 0
22$				;--- write logical and ---
	lea.l 23$(pc),a0	;get and-text
	moveq #1,d0		;text-size:= 1
	bra.s 20$		;write and-text into text
23$	dc.b "/",0		;and-text
10$				;--- write negation ---
	lea.l 15$(pc),a0	;get negation-text
	moveq #1,d0		;text-size:= 1
	bra.s 20$		;write negation-text into text
15$	dc.b "-",0		;negation-text
11$				;--- write space ---
	lea.l 18$(pc),a0	;get negation-text
	moveq #1,d0		;text-size:= 1
	bra.s 20$		;write negation-text into text
18$	dc.b " ",0		;negation-text
20$				;--- write text into text ---
	exg a3,a4		;get stack-ring of text
	bsr Push_Stack		;add text-list to text
	exg a3,a4		;save stack-ring of text
	rts
2$				;--- term-list is bracket-list ---
	move.w (a5),d3		;get code
	asl.w #3,d3		;code * 8
	lea.l 14$(pc,d3.w),a0	;get bracket-text-module
	move.l (a0)+,d0		;get bracket-text and text-size
	bsr.s 20$		;write bracket-text into text
	bra 8$			;next term-list
14$	dc.l 2			;bracket-text-modules
	dc.b "(   "
	dc.l 3
	dc.b "-(  "
	dc.l 2
	dc.b ")   "
	dc.l 2
	dc.b ")   "
	dc.l 3
	dc.b "/(  "
	dc.l 4
	dc.b "/-( "
	dc.l 4
	dc.b "NIL "
	dc.l 4
	dc.b "ONE "


*****************************************
*                                       *
*    I  N  T  E  R  P  R  E  T  E  R    *
*                                       *
*****************************************

;=============================;
;  table of reserved symbols  ;
;=============================;

Code_VSymbSt	= LI_VSymb	;code for var-symbols-start
Code_Numb	= 4*2		;code for number

ResSymbols_Table
	dc.b 10,0
	dc.w 4*1
	dc.b "(",0
	dc.w 4*3
	dc.b ")",0
	dc.w 4*4
	dc.b "-",0
	dc.w 4*5
	dc.b "/",0
	dc.w 4*6

	dc.b "[",0
	dc.w 4*7
	dc.b "]",0
	dc.w 4*8
	dc.b "+",0
	dc.w 4*9
	dc.b ",",0
	dc.w 4*10

	dc.b "ttf",0
	dc.w 4*11
	dc.b "TTF",0
	dc.w 4*12
	dc.b "ste",0
	dc.w 4*13
	dc.b "STE",0
	dc.w 4*14
	dc.b "sum",0
	dc.w 4*15
	dc.b "SUM",0
	dc.w 4*16
	dc.b "debug",0
	dc.w 4*17

	dc.w 0
	even

;==================================;
;  data of variable-symbols-stack  ;
;==================================;

Size_VarSymbStack	= 500	;max. number of entries in var-symb-stack
VarSymb_Stack	dc.l 0		;stack of variable-symbols

;=====================;
;  data of term-ring  ;
;=====================;

Term_Ring	dc.l 0		;term-ring

;================================;
;  data of symbols-data-manager  ;
;================================;

SymbolsDM	dc.l 0		;symbols-data-manager


Open_SymbolsServer
*************************
*  open symbols-server  *
*************************

	movem.l d0-d1/a0-a3,-(a7)
				;--- install data-manager of symbols ---
	bsr Open_DataManager	;open data-manager for symbols
	move.l a2,SymbolsDM	;save data-manager of symbols
				;--- enter reserved symbols ---
	lea.l ResSymbols_Table(pc),a1  ;get table of reserved symbols
2$	bsr Get_StringLength	;get string-length of symbol
	beq.s 3$		;end of symbols-table? =yes
	move.l a1,a3		;get symbol
	bsr Enter_Date		;enter symbol in data-manager
	lea.l 3(a1,d0.l),a1	;set table-pointer to next symbol
	lea.l -2(a1),a3		;get code
	moveq #2,d0		;code-length:= 2
	bsr Enter_Date_Link	;enter code and link with symbol
	bra.s 2$		;next symbol
3$	movem.l (a7)+,d0-d1/a0-a3
	rts

Close_SymbolsServer
**************************
*  close symbols-server  *
**************************

	movem.l d0/a2,-(a7)
	move.l SymbolsDM(pc),a2	;get symbols-data-manager
	bsr Open_Ring		;open ring: symbols-data-manager
	bsr Close_DataManager	;close data-manager of symbols
	movem.l (a7)+,d0/a2
	rts

Execute_SourceCode
*************************
*  execute source-code  *
*************************
;a0,source-code-ring

	movem.l d0-d7/a0-a3,-(a7)
	move.l SymbolsDM(pc),a2	;get symbols-data-manager
	clr.l d5		;reset counter of variable-symbols
	clr.l d4		;reset negation-flag
	moveq #4,d6		;set and-flag
	clr.l d7		;reset or-flag
	moveq #Code_VSymbSt,d3	;counter of new symbols:= var-symbols-start
1$				;--- get text-line ---
	bsr Get_Text_Line	;get line from source-code
	move sr,-(a7)		;save ring_empty-status
	move.l a0,-(a7)		;save source-code-ring
				;--- code text-line ---
	bsr Code_TextLine	;code text-line
	move.l a1,a0		;get codes-ring
				;--- execute code ---
	move.l Term_Ring(pc),a1	;get term-ring
	bsr Execute_CodesRing	;execute codes-ring
	move.l a1,Term_Ring	;save term-ring
	bsr Delete_Ring		;delete codes-ring
				;--- next text-line ---
	move.l (a7)+,a0		;get source-code-ring
	move (a7)+,ccr		;get ring_empty-status
	bne.s 1$		;end of source-code? =no
				;--- end ---
	move.l Term_Ring(pc),a1	;get term-ring
	bsr Set_TermRing_End	;set end of term-ring
	move.l a1,Term_Ring	;save term-ring
	movem.l (a7)+,d0-d7/a0-a3
	rts

Execute_CodesRing
************************
*  execute codes-ring  *
************************
;a0,codes-ring
;d3,new-symbols-counter
;a2,symbols-data-manager
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified
;_a0/d3,modified

	movem.l d0-d1/a0,-(a7)
	move.l a0,d1		;save first list of codes-ring
2$	move.w 8(a0),d0		;get identity-code
	jsr CodeJumps(pc,d0.w)	;jump routine on code
	move.l (a0),a0		;get next code-list
	cmp.l a0,d1		;end of codes?
	bne.s 2$		;=no
Found_EndMark
	movem.l (a7)+,d0-d1/a0
	rts

;==============;
;  code-jumps  ;
;==============;
CodeJumps
	bra.w CJ_VarSymbol
	bra.w CJ_EndMark
	bra.w CJ_Number
	bra.w CJ_OpenBracket
	bra.w CJ_CloseBracket
	bra.w CJ_Negation
	bra.w CJ_And
	bra.w CJ_OpenBrack2
	bra.w CJ_CloseBrack2
	bra.w CJ_Add
	bra.w CJ_Comma
	bra.w CJ_Term_To_File
	bra.w CJ_Term_To_File
	bra.w CJ_Shorten_Term
	bra.w CJ_Shorten_Term
	bra.w CJ_Sum
	bra.w CJ_Sum
	bra.w debug

debug
	exg a0,a1
	bsr Open_Debugger
	bsr Debug_Ring
	bsr Close_Debugger
	exg a0,a1
	rts

CJ_EndMark
********************
*  code: end-mark  *
********************

	addq.l #4,a7		;skip return-addr
	bra Found_EndMark	;leave routine "execute codes-ring"

CJ_OpenBrack2
CJ_CloseBrack2
CJ_Add
CJ_Comma
Error_IllegalChar
*************************
*  break: illegal char  *
*************************

	moveq #EC_IllegalChar,d0	;error-code: illegal char
	bra Break			;break

CJ_Sum
***************
*  code: sum  *
***************
;a0,codes-ring
;a2,symbols-data-manager
;_a0,modified

	movem.l d0/a1,-(a7)
	move.l a0,a1		;save "sum"-code-list
	move.l (a0),a0		;get next code-list
	bsr Get_CodeL_VSymb	;test: code-list contains var-symb
	move.l (a0),a0		;get next code-list
	bsr Get_CodeL_Number	;test: code-list contains number?
	move.l a0,a1		;save code-list of first number
	move.l (a0),a0		;get next code-list
	bsr Get_CodeL_Number	;test: code-list contains number?
	move.l (a0),a0		;end-list:= next code-list
	exg a1,a0		;get "sum"-code-list
	bsr Remove_Ring		;remove sum-code-queue
	bsr Fuse_Ring		;fuse sum-code-queue into one list
	move.l a0,a3		;get list of sum-code-queue
	bsr Enter_DateL		;enter sum-code-queue in symb-data-manager
	move.l a1,a0		;get codes-ring
	movem.l (a7)+,d0/a1
	rts

Get_CodeL_Number
************************************
*  get number of number-code-list  *
************************************
;a0,code-list
;_d0,number
* code-list does not contain number ==> break *

	cmp.w #Code_Numb,8(a0)	;code-list contains number?
	bne.s 1$		;=no
	move.l 10(a0),d0	;get number
	rts
1$	moveq #EC_IllegalNumb,d0  ;set error-code: illegal number
	bra Break		;break

Get_CodeL_VSymb
****************************************
*  get var-symb of var-symb-code-list  *
****************************************
;a0,code-list
;_d0,code of var-symb
* code-list does not contain var-symb ==> break *

	tst.w 8(a0)		;code-list contains var-symb?
	bne.s 1$		;=no
	move.l 10(a0),d0	;get code of var-symb
	rts
1$	moveq #EC_IllegalVSymb,d0  ;set error-code: illegal var-symbol
	bra Break		;break

CJ_Shorten_Term
************************
*  code: shorten term  *
************************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	bsr Set_TermRing_End	;set end of term-ring
	move.l a0,-(a7)
	move.l (a1),a0		;get start of term-ring
	bsr Eliminate_Brack	;eliminate brackets of term-ring
	move.l a0,-4(a7)	;term-ring was deleted?
	beq.s 1$		;=yes
	bsr Shorten_Term	;shorten term-ring
	cmp.w #LI_One,8(a0)	;term = logical one?
	beq.s 1$		;=yes
	bra.s 10$
	bsr Negate_Term		;negate term-ring
	bne.s 2$		;term-ring was deleted? =no
	bsr Install_OneList	;term:= logical one
	bra.s 1$		;end
2$	cmp.w #LI_One,8(a0)	;term = logical one?
	bne.s 3$		;=no
	bsr Delete_Ring		;delete term-ring
	bra.s 1$
3$	bsr Negate_Term		;negate term-ring
	beq.s 1$		;term-ring was deleted? =yes
10$	move.l -(a0),a0		;term-ring:= last list of term-ring
1$	move.l a0,a1
	move.l (a7)+,a0
	rts

CJ_Number
******************
*  code: number  *
******************
;a0,code-list
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	tst.l 10(a0)		;number = 0?
	bne Error_IllegalChar	;=no
	bsr CJ_OpenBracket	;set "open bracket"
	bra CJ_CloseBracket	;set "close bracket"

CJ_Negation
********************
*  code: negation  *
********************
;d4,negation-flag
;_d4,modified

	moveq #1,d4		;set negation-flag
	rts

CJ_OpenBracket
************************
*  code: open bracket  *
************************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	bsr Close_New_Term	;close new term if exists
	tst.l d7		;or-flag set?
	beq.s 1$		;=no
	tst.l d6		;and-flag set?
	beq.s 1$		;=no
	bsr Bracket_TermList	;put term-list in brackets
	clr.l d6		;reset and-flag
	clr.l d7		;reset or-flag
1$	bsr Add_OpenBracket	;add "open bracket" to term
	or.w d4,8(a1)		;copy negation-flag into bracket-list
	or.w d6,8(a1)		;copy and-flag into bracket-list
	clr.l d4		;reset negation-flag
	moveq #4,d6		;set and-flag
	rts

CJ_CloseBracket
*************************
*  code: close bracket  *
*************************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	bsr Close_New_Term	;close new term if exists
	bsr Add_CloseBracket	;add "close bracket" to term
	clr.l d4		;reset negation-flag
	clr.l d6		;reset and-flag
	clr.l d7		;reset or-flag
	rts

Close_New_Term
********************
*  close new term  *
********************
;d5,counter of variable-symbols
;d6,and-flag
;a1,term-ring
;_d5/a1,modified

	tst.l d5		;variable-symbols exist?
	beq.s 1$		;=no
	movem.l d0/a0,-(a7)
	move.l a1,-(a7)		;save term-ring
	move.l d5,d0		;get counter of var-symbols
	asl.l #1,d0		;size of new term:= counter * 2
	move.l VarSymb_Stack(pc),a0  ;get var-symb-stack
	bsr Install_List_Set	;install list of new term
	move.l a1,a0		;get list of new term
	move.l (a7)+,a1		;get term-ring
	bsr Add_New_TermList	;add new term-list to main-term
	clr.l d5		;reset counter of var-symbols
	tst.l d6		;and-flag set?
	bne.s 2$		;=yes
	bsr Bracket_TermList	;put new term-list in brackets
2$	movem.l (a7)+,d0/a0
1$	rts

CJ_And
***********************
*  code: logical and  *
***********************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	bsr Close_New_Term	;close new term if exists
	clr.l d4		;reset negation-flag
	moveq #4,d6		;set and-flag
	clr.l d7		;reset or-flag
	rts

CJ_VarSymbol
***************************
*  code: variable-symbol  *
***************************
;a0,codes-ring
;d3,new-symbols-counter
;a2,symbols-data-manager
;d4,negation-flag
;d5,counter of variable-symbols
;d7,or-flag
;_d4/d5/d7,modified
;_a0/d3,modified




Push_VarSymbol
***************************************
*  push var-symbol on var-symb-stack  *
***************************************
;d4,negation-flag
;d5,counter of variable-symbols
;d7,or-flag
;a0,code-list
;_d4/d5/d7,modified

	movem.l d0/a2,-(a7)
	move.l VarSymb_Stack(pc),a2  ;get stack of variable-symbols
	lsl.l #1,d5		;var-symb-counter * 2 (2 bytes = 1 v-symb)
	move.w 12(a0),d0	;get number of variable-symbol
	asl.w #1,d0		;number * 2
	or.b d4,d0		;copy negation-flag into number
	move.w d0,(a2,d5.l)	;push variable-symbol on var-symbols-stack
	lsr.l #1,d5		;var-symb-counter / 2
	addq.l #1,d5		;inc var-symb-counter
	clr.l d4		;reset negation-flag
	moveq #1,d7		;set or-flag
	movem.l (a7)+,d0/a2
	rts

Set_TermRing_End
**************************
*  set end of term-ring  *
**************************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring
;_d4/d5/d6/d7/a1,modified

	bsr CJ_And		;close remaining term
	bra Close_Remain_Brack	;close remaining brackets

CJ_Term_To_File
****************************
*  code: put term to file  *
****************************
;d4,negation-flag
;d5,counter of variable-symbols
;d6,and-flag
;d7,or-flag
;a1,term-ring (0 signals empty ring)
;a0,code-list
;_d4/d5/d6/d7/a1,modified

	bsr Set_TermRing_End	;set end of term-ring
	movem.l d0-d3/a0-a3,-(a7)
				;--- make headline-text ---
	exg a1,a3		;save term-ring
	lea.l 3$(pc),a0		;get headline-text
	moveq #4$-3$,d0		;get size of headline-text
	bsr Install_List_Set	;install list of headline-text
	exg a1,a3		;save list of headline-text
				;--- decode term into text ---
	move.l a1,d0		;term-ring exists?
	beq.s 5$		;=no
	move.l SymbolsDM,a2	;get symbols-data-manager
	bsr Open_Ring		;open ring: symbols-data-manager
	move.l (a1),a1		;get start of term-ring
	bsr Decode_Term		;decode term into text
	bsr Close_Ring		;close ring: symbols-data-manager
	moveq #75,d0		;max. text-line-size:= 75
	bsr Correct_TextLines_Size  ;make text-lines
	move.l a3,a1		;get headline-list
	bsr Add_Ring		;add headline to text
5$				;--- save text ---
	move.l a3,a0		;get text-ring
	move.l #1$,d1		;get standard-filename
	bsr Open_File_New	;open file for text
	bsr Copy_Ring_To_File	;copy text-ring into file
	bsr Close_File		;close file of text
	bsr Delete_Ring		;delete text-ring
	movem.l (a7)+,d0-d3/a0-a3
2$	rts
1$	dc.b "ram:term-out",0	;standard-filename
3$	dc.b 10,"***  T E R M  ***",10,10	;headline-text
4$	even

Open_VarSymb_Stack
************************************
*  open stack of variable-symbols  *
************************************

	movem.l d0/a0,-(a7)
	move.l #Size_VarSymbStack*4,d0	;get size of var-symb-stack
	bsr Alloc_Mem			;alloc mem for var-symb-stack
	move.l a0,VarSymb_Stack		;save var-symb-stack
	movem.l (a7)+,d0/a0
	rts

Close_VarSymb_Stack
*************************************
*  close stack of variable-symbols  *
*************************************

	movem.l d0/a0,-(a7)
	move.l #Size_VarSymbStack*4,d0	;get size of var-symb-stack
	move.l VarSymb_Stack(pc),a0	;get var-symb-stack
	move.l a0,-4(a7)		;var-symb-stack exists?
	beq.s 1$			;=no
	bsr Free_Mem			;free mem of var-symb-stack
	clr.l VarSymb_Stack		;reset var-symb-stack
1$	movem.l (a7)+,d0/a0
	rts

Reset_TermRing
*********************
*  reset term-ring  *
*********************

	move.l a0,-(a7)
	move.l Term_Ring(pc),a0	;get term-ring
	bsr Delete_Ring		;delete term-ring
	clr.l Term_Ring		;reset term-ring
	move.l (a7)+,a0
	rts

Check_VarSymbols
*************************************
*  check and code variable-symbols  *
*************************************
;a0,codes-ring

Code_TextLine
********************
*  code text-line  *
********************
;a1,list of text-line (will be deleted)
;d3,counter of new symbols
;_a1,codes-ring

	movem.l d0-d1/a0/a2-a3,-(a7)
				;--- analyse text-line ---
	move.l 4(a1),d1		;get size of text-line
	lea.l 8(a1),a3		;get text-line
	bsr Analyse_String	;analyse text-line
	move.l a0,a3		;save symbols-ring
	move.l a1,a0		;get list of text-line
	bsr Delete_List		;delete list of text-line
	move.l a3,a0		;get symbols-ring
				;--- code symbols of text-line ---
	bsr Open_Ring		;open ring: symbols-data-manager
	bsr Code_Symbols	;code symbols-ring
	bsr Delete_Ring		;delete symbols-ring
	bsr Close_Ring		;close ring: symbols-data-manager
	movem.l (a7)+,d0-d1/a0/a2-a3
	rts


*****************************************************************
*                                                               *
*    T  E  X  T  S  T  R  I  N  G  -  R  O  U  T  I  N  E  S    *
*                                                               *
*****************************************************************

Code_Symbols
********************************
*  convert symbols into codes  *
********************************
;a0,symbols-ring
;d3,counter of new symbols
;a2,data-manager
;_a1,codes-ring
;_d3,counter of new symbols (new counter-position)
;_block-structure of lists:
;  symbol existed ==> found code
;  symbol did not exist ==> $0000, {counter of new symbols}

	movem.l d0-d2/a0/a3-a4,-(a7)
	move.l a0,a4		;get symbols-ring
	clr.l d1		;set "there is no codes-ring"
	move.l a4,d2		;save first list of symbols-ring
4$				;--- enter symbol in data-manager ---
	move.l 4(a4),d0		;get size of symbol
	lea.l 8(a4),a0		;get addr of symbol
	bsr Test_String_Numb	;test string on number
	bsr Calc_String_Numb	;calc number

	bpl.s 7$		;string is number? =no
7$	move.l a0,a3		;get addr of symbol
	bsr Enter_Date		;enter symbol in data-manager
	beq.s 1$		;date already entered? =yes
				;--- new symbol ---
	move.l a0,a3		;save addr of entered list
	moveq #6,d0		;6 bytes
	bsr Install_List	;install list for code
	clr.w 8(a0)		;first word of list-block:= 0
	move.l d3,10(a0)	;set counter of new symbols in code-list
	addq.l #1,d3		;inc counter of new symbols
	exg a0,a3		;get entered list and installed code-list
	bsr Enter_DateL_Link	;enter code-list and link with symbol-list
	bra.s 5$		;duplicate code-list and add to code-ring
1$				;--- known symbol ---
	move.l (a0),a0		;get code-list of symbol
5$	bsr Duplicate_List	;duplicate code-list
	move.l a1,a0		;get duplicated code-list
2$				;--- add code-list to codes-ring ---
	move.l d1,a1		;get codes-ring
	bsr Add_List		;add new code-list to codes-ring
3$	move.l a0,d1		;save codes-ring
				;--- get next symbol-list ---
	move.l (a4),a4		;get next symbol-list of symbols-ring
	cmp.l a4,d2		;all symbols checked?
	bne.s 4$		;=no
	move.l (a0),a1		;get symbols-ring
	movem.l (a7)+,d0-d2/a0/a3-a4
	rts

Test_String_Numb
***************************
*  test string on number  *
***************************
;a0,string
;d0,string-size
;_NF,1 <==> string is number

	move.l d0,-(a7)
	tst.l d0		;string-size = 0?
	beq.s 1$		;=yes
	bra.s 4$		;test string
2$	cmp.b #"0",(a0,d0.l)	;char is digit?
	blo.s 1$		;=no
	cmp.b #"9",(a0,d0.l)
	bhi.s 1$		;=no
4$	subq.l #1,d0		;dec size-counter
	bpl.s 2$		;end of string? =no
	bra.s 3$		;string is number
1$	and #-8-1,ccr		;set flag "string is no number"
3$	movem.l (a7)+,d0
	rts

Calc_String_Number
***************************************
*  calculate number of number-string  *
***************************************
;a0,string (must not contain chars but digits)
;d0,string-size (0 ==> number:= 0)
;_d0,number
;_ZF,0 <==> number overflowed

	movem.l d1-d3/a1,-(a7)
				;--- check on overflow ---
	cmp.l #11,d0		;string-size overflow?
	bhi.s 1$		;=yes
				;--- calculate number ---
	lea.l 10$,a1		;get factors-table
	clr.w d2		;number:= 0
	bra.s 3$		;start calculation
2$	clr.w d1		;reset helping variable
	move.b (a0,d0.w),d1	;get digit
	sub.b #"0",d1		;get value of digit
	move.w d1,d3		;save value of digit
	mulu (a1)+,d3		;value of digit * hi-word of factor
	swap d3			;product * $10000
	tst.w d3		;overflow of product?
	bne.s 1$		;=yes
	add.l d3,d2		;add product to number
	bcs.s 1$		;overflow? =yes
	mulu (a1)+,d1		;value of digit * lo-word of factor
	add.l d1,d2		;add product to number
	bcs.s 1$		;overflow? =yes
3$	dbra 2$,d0		;next digit
				;--- no overflow ---
	move.l d2,d0		;get number
	or #4,ccr		;set "no overflow"
4$	movem.l (a7)+,d1-d3/a1
	rts
1$				;--- overflow ---
	and #-4-1,ccr		;set "number overflowed"
	bra.s 4$		;end
				;--- factors-table ---
10$	dc.l 1
	dc.l 10
	dc.l 100
	dc.l 1000
	dc.l 10000
	dc.l 100000
	dc.l 1000000
	dc.l 10000000
	dc.l 100000000
	dc.l 1000000000

Analyse_String
**************************************************
*  divide string into symbols and special chars  *
**************************************************
;a3,string-addr
;d1,string-size
;_a0,ring containing symbols/special chars

	movem.l d0-d1/d3/a1-a3,-(a7)
	move.l #0,a2		;set flag "there is no ring"
1$				;--- get string ---
	clr.l d0		;reset length-counter
2$				;--- get char of string ---
	move.b (a3)+,d3		;get byte
	addq.l #1,d0		;inc length-counter
	subq.l #1,d1		;dec size of input-string
	bmi.s 9$		;end of input-string? =yes
				;--- analyse char ---
	cmp.b #" ",d3		;char is space?
	beq.s 3$		;=yes
	cmp.b #"_",d3		;char is "_"?
	beq.s 2$		;=yes
	cmp.b #"0",d3		;char is digit?
	blo.s 4$		;=no
	cmp.b #"9",d3
	bls.s 2$		;=yes
	cmp.b #"A",d3		;char is letter?
	blo.s 4$		;=no
	cmp.b #"Z",d3
	bls.s 2$		;=yes
	cmp.b #"a",d3
	blo.s 4$		;=no
	cmp.b #"z",d3
	bls.s 2$		;=yes
4$				;--- string is special char ---
	bsr.s 11$		;add previous string to ring
	bsr.s 5$		;add special char to ring
	bra.s 1$		;get next string
3$				;--- string is space ---
	bsr.s 11$		;add previous string to ring
	bra.s 1$		;get next string
11$				;--- add previous string to ring ---
	cmp.l #1,d0		;previous string is symbol?
	beq.s 6$		;=no
	subq.l #1,d0		;dec length-counter
	subq.l #1,a3		;dec pointer
	bsr.s 5$		;add symbol to ring
	addq.l #1,a3		;inc pointer
	moveq #1,d0		;length-counter:= 1
6$	rts
5$				;--- add list of string to ring ---
	move.l a3,a0		;get pointer
	sub.l d0,a0		;string-start:= pointer - length-counter
	bsr Install_List_Set	;install list of string
	move.l a2,d0		;ring exists?
	beq.s 7$		;=no
	bsr Add_List_2		;add string to ring
7$	move.l a1,a2		;new list:= ring
	rts
9$				;--- end of input-string ---
	tst.l d0		;has a symbol remained?
	beq.s 10$		;=no
	bsr.s 11$		;add symbol to ring
10$	move.l (a2),a0		;get ring-start
	movem.l (a7)+,d0-d1/d3/a1-a3
	rts

Get_StringLength
***********************
*  get string-length  *
***********************
;a1,string (0 <=> string-end, not part of the string)
;_d0,string-length
;_ZF,1 <=> string-length = 0

	move.l a1,-(a7)
	moveq #-1,d0		;reset counter
1$	addq.l #1,d0		;inc counter
	tst.b (a1)+		;end of string?
	bne.s 1$		;=no
	move.l (a7)+,a1
	tst.l d0		;string-length = 0?
	rts

Get_Text_Line
**************************************
*  get text-line of ring and delete  *
**************************************
;a0,ring
;_a0,ring (list after deleted block)
;_a1,list
;_ZF,1 <==> new ring is empty

	movem.l d0-d3/a2,-(a7)
				;--- search line-feed ---
	move.l a0,-(a7)		;save ring
	move.l a0,a1		;start:= ring
	clr.l d1
	move.l a1,a2		;end:= start
	move.l d1,d2
	lea.l 1$(pc),a0		;string:= {line-feed}
	moveq #1,d0
	bsr Search_Ring_String	;search line-feed within ring
	bne.s 2$		;line-feed found? =no
	addq.l #1,d3		;line-size:= offset of found position + 1
2$				;--- remove text-line ---
	move.l (a7)+,a1		;get ring
	clr.l d1		;list-offset:= 0
	move.l d3,d0		;get line-size
	bsr Remove_Ring_Block	;remove line from ring
	cmp.l a0,a1		;block is entire ring?
	move sr,-(a7)		;save ring_empty-status
	bsr Fuse_Ring		;fuse line-ring into list
	exg a0,a1		;get ring and line-list
	move (a7)+,ccr		;get ring_empty-status
	movem.l (a7)+,d0-d3/a2
	rts
1$	dc.b 10,0		;line-feed

Correct_TextLines_Size
*******************************************************
*  check and correct size of text-lines of text-ring  *
*******************************************************
;a0,text-ring (0 ==> no correcting)
;d0,max. line-size

	movem.l d0-d5/a0-a1,-(a7)
	move.l a0,d1		;term exists?
	beq.s 10$		;=no
	move.l a0,a1		;pointer:= ring
	clr.l d1
	bsr Legal_List_Offset	;legalize list-offset
	move.l a1,a0		;save first list of ring
	clr.l d4		;line-size:= 0
	moveq #-1,d5		;set "no space-position saved"
				;--- check text-ring ---
3$	move.b 8(a1,d1.l),d3	;get text-byte
	cmp.b #" ",d3		;text-byte = space?
	beq.s 2$		;=yes
	cmp.b #10,d3		;text-byte = line-feed?
	beq.s 1$		;=yes
7$	addq.l #1,d4		;line-size + 1
4$	addq.l #1,d1		;pointer + 1
	bsr Legal_List_Offset	;legalize list-offset
	cmp.l a0,a1		;entire ring checked?
	bne.s 3$		;=no
	tst.l d1
	bne.s 3$		;=no
10$	movem.l (a7)+,d0-d5/a0-a1
	rts
1$				;--- line-feed found ---
	cmp.l d0,d4		;line-size overflowed?
	bhi.s 6$		;=yes (do as there were a space)
9$	clr.l d4		;line-size:= 0
	moveq #-1,d5		;set "no space-position saved"
	bra.s 4$		;next line
2$				;--- space found ---
	cmp.l d0,d4		;line-size overflowed?
	bhi.s 6$		;=yes
	move.l d4,d5		;save position of space within line
	bra.s 7$		;next text-byte
6$	tst.l d5		;there is a space in line?
	bmi.s 8$		;=no
	sub.l d4,d1		;pointer - (line-size - saved space-pos.)
	add.l d5,d1
	bsr Legal_List_Offset	;legalize list-offset
8$	move.b #10,8(a1,d1.l)	;replace space by line-feed
	bra.s 9$		;next line


********************************************
*                                          *
*    D  A  T  A  -  M  A  N  A  G  E  R    *
*                                          *
********************************************

;-----------------------------------------------------------------;
;  remark: size of data must not overflow $ffff but nevertheless  ;
;          keep on using long-words for size                      ;
;-----------------------------------------------------------------;

;======================================;
;  constants for list of data-manager  ;
;======================================;

DatManag_Size		= 4	;size of list-block
DatManag_NumEntr	= 8	;list-offset: number of entries


Open_DataManager
***********************
*  open data-manager  *
***********************
;_a2,data-manager

	movem.l d0/a0,-(a7)
	moveq #DatManag_Size,d0		;install ring for management
	bsr Install_List
	clr.l DatManag_NumEntr(a0)	;number of entries:= 0
	move.l a0,a2			;save list
	movem.l (a7)+,d0/a0
	rts

Close_DataManager
************************
*  close data-manager  *
************************
;a2,data-manager

	move.l a2,-4(a7)	;data-manager does exist?
	beq.s 3$		;=no
	movem.l a0-a1/a3,-(a7)
2$	move.l -4(a2),a1	;get last list of addrs-ring
	cmp.l a2,a1		;all addrs removed?
	beq.s 1$		;=yes
	addq.l #4,a1		;list-block-addr - 4
	add.l (a1),a1		;+ list-block-size = pointer to last addr
	move.l (a1),a3		;get last addr of addrs-ring
	bsr Remove_DataL	;remove data-ring from data-manager
	bsr Delete_Ring		;delete removed data-ring
	bra.s 2$		;delete next data-ring
1$	move.l a2,a0		;get list of data-manager
	bsr Delete_List		;delete list of data-manager
	movem.l (a7)+,a0-a1/a3
3$	rts

Remove_Data
****************************************
*  remove data-ring from data-manager  *
****************************************
;a3,addr of date
;d0,size of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	bsr Remove_Date		;remove date from data-manager
	bne.s 1$		;date not found? =yes
	bra.s Remove_Data_Intern ;remove data-ring
1$	rts

Remove_DataL
****************************************
*  remove data-ring from data-manager  *
****************************************
;a3,list of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	bsr Remove_DateL	;remove date from data-manager
	bne.s 1$		;date not found? =yes
	bra.s Remove_Data_Intern ;remove data-ring
1$	rts

Remove_Data_Intern
****************************************
*  remove data-ring except first list  *
****************************************
;a0,list of date (will not be removed)
;_ZF,1

	movem.l a0/a3,-(a7)
	bra.s 3$		;start removing-loop
2$	bsr Remove_DateL	;remove date of data-ring from data-manager
3$	move.l (a0),a3		;get next list of data-ring
	cmp.l (a7),a3		;all lists of data-ring checked?
	bne.s 2$		;=no
	movem.l (a7)+,a0/a3
	rts

Remove_DateL
****************************************************
*  remove date of list from data-manager and link  *
****************************************************
;a3,list of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	movem.l d0/a3,-(a7)
	addq.l #4,a3		;get block-size and block-start of list 
	move.l (a3)+,d0
	bsr.s Remove_Date	;remove date from data-manager
	movem.l (a7)+,d0/a3
	rts

Remove_Date
********************************************
*  remove date from data-manager and link  *
********************************************
;a3,addr of date
;d0,size of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	movem.l d0-d1/a1,-(a7)
	bsr Search_Date_Pointer	;search date in data-manager
	bne.s 1$		;date not found? =yes
	moveq #4,d0		;delete addr of list in addrs-ring
	bsr Delete_Ring_Block
	subq.l #1,DatManag_NumEntr(a2)	;dec number of entries
	clr.b d0		;set flag "date found"
1$	movem.l (a7)+,d0-d1/a1
	rts

Enter_Date_Link
***********************************************************
*  enter date in data-manager and link with managed date  *
***********************************************************
;a3,addr of date
;d0,size of date
;a0,list of managed date (0 ==> no linking)
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,1 <==> date has already been entered
* if date has already been entered, the two managed data will just be
; linked as ordered *

	or #4,ccr			;set block-mode
	bra.s Enter_Date_Link_Intern	;enter date and link

Enter_DateL_Link
*******************************************************************
*  enter date of list in data-manager and link with managed date  *
*******************************************************************
;a3,list of date (exactly this list will be entered)
;a0,list of managed date (0 ==> no linking)
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,1 <==> date has already been entered
* if date has already been entered, the two managed data will just be
; linked as ordered *

	and #-1-4,ccr			;set list-mode
	bra.s Enter_Date_Link_Intern	;enter date and link
	nop

Enter_Date_Link_Intern
***********************************************************
*  enter date in data-manager and link with managed date  *
***********************************************************
;ZF,0 <==> input: a3 = list of date
;ZF,1 <==> input: a3/d0 = addr of date/size of date
;a0,list of managed date (0 ==> no linking)
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,1 <==> date has already been entered
* if date has already been entered, the two managed data will just be
; linked as ordered *

	movem.l a1,-(a7)
	move.l a0,a1		;save list of managed date
	bsr.s 2$		;enter date in data-manager
	move sr,-(a7)		;save status
	bsr Add_List		;add list of date to list of managed date
1$	move (a7)+,ccr		;get status
	move.l (a7)+,a1
	rts
2$	beq.s Enter_Date	;zf=1 ==> block-mode
	bne.s Enter_DateL	;zf=0 ==> list-mode
	nop

Enter_DateL
****************************************
*  enter date of list in data-manager  *
****************************************
;a3,list of date (exactly this list will be entered)
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,1 <==> date has already been entered

	movem.l d0-d1/a1,-(a7)
	addq.l #4,a3		;get block-size and block-start of list 
	move.l (a3)+,d0
	bsr Search_Date_Pointer	;search date in data-manager
	beq.s 2$		;date already entered? =yes
	moveq #4,d0		;alloc l-word for list-addr in addrs-ring
	bsr Alloc_Ring_Block
	subq.l #8,a3		;get list of date
	move.l a3,a0		;get list of date
	move.l a3,8(a1)		;set list-addr in addrs-ring
	addq.l #1,DatManag_NumEntr(a2)	;inc number of entries
2$	movem.l (a7)+,d0-d1/a1
	rts

Enter_Date
********************************
*  enter date in data-manager  *
********************************
;a3,addr of date
;d0,size of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,1 <==> date has already been entered

	movem.l d1/a1/a4,-(a7)
	bsr Search_Date_Pointer	;search date in data-manager
	beq.s 2$		;date already entered? =yes
	move.l d0,a0		;save size of date
	moveq #4,d0		;alloc l-word for list-addr in addrs-ring
	bsr Alloc_Ring_Block
	move.l a0,d0		;get size of date
	lea.l 8(a1),a4		;save addr of allocated block
	move.l a3,a0		;get addr of date
	bsr Install_List_Set	;install list containing date
	move.l a1,(a4)		;set list-addr in addrs-ring
	move.l a1,a0		;get list-addr
	addq.l #1,DatManag_NumEntr(a2)	;inc number of entries
2$	movem.l (a7)+,d1/a1/a4
	rts

Search_DateL
*****************************************
*  search date of list in data-manager  *
*****************************************
;a3,list of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	movem.l d0/a3,-(a7)
	addq.l #4,a3		;get block-size and block-start of list 
	move.l (a3)+,d0
	bsr.s Search_Date	;search date in data-manager
	movem.l (a7)+,d0/a3
	rts

Search_Date
*********************************
*  search date in data-manager  *
*********************************
;a3,addr of date
;d0,size of date
;a2,data-manager
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	movem.l d1/a1,-(a7)
	bsr.s Search_Date_Pointer  ;search date in data-manager
	movem.l (a7)+,d1/a1
	rts

Search_Date_Pointer
***********************************************************
*  search managed data and get pointer within addrs-ring  *
***********************************************************
;a3,addr of date
;d0,size of date
;a2,data-manager
;_pointer within addrs-ring to list of wanted data:
; _a1,list
; _d1,list-offset (does not exceed list)
;_a0,list of date in data-manager
;_ZF,0 <==> date not found

	movem.l d2-d4/a4-a5,-(a7)
	move.l DatManag_NumEntr(a2),d4	;get number of entries in ring
	move.l (a2),a1			;get addrs-ring
				;---  s e a r c h  ---
	clr.l d1		;set pointer on ring-start
	asl.l #2,d4		;number of entries * 4 (4 bytes per addr)
3$				;--- divide block ---
	move.l d4,d3		;save number of entries
	lsr.l #1,d3		;lower-number:= int(number of entries / 2)
	and.b #-1-3,d3		
	add.l d3,d1		;set list-offset on start of higher part
	bsr Legal_List_Offset	;legalize list-offset
	tst.l d4		;block is empty?
	beq.s 4$		;=yes
	move.l 8(a1,d1.l),a0	;get list of date
				;--- compare data ---
	cmp.w 6(a0),d0		;size of date = size of list-block?
	bne.s 5$		;=no
	lea.l 8(a0),a4		;get addr of list-block
	move.l a3,a5		;get addr of date
	move.w d0,d2		;get size of date
	beq.s 2$		;size = 0? =yes
	subq.w #1,d2		;size - 1
6$	cmp.b (a4)+,(a5)+	;compare data-bytes
7$	dbne d2,6$		;data-bytes are equal? =no
	beq.s 2$		;wanted date = managed date? =yes
5$	bhi.s 1$		;wanted date > managed date? =yes
				;--- wanted date < managed date ---
	sub.l d3,d1		;set pointer on start of lower part
	move.l d3,d4		;get new number of entries (= lower-number)
	bra.s 3$		;check new block
1$				;--- wanted date > managed date ---
	sub.l d3,d4		;get new number of entries
	subq.l #4,d4		;    (= higher-number - 1)
	addq.l #4,d1		;set pointer on start of new block
	bra.s 3$		;check new block
4$				;--- date not found ---
	and #-1-4,ccr		;set flag "date not found"
2$	movem.l (a7)+,d2-d4/a4-a5  ;--- date found / end ---
	rts


*****************************************
*                                       *
*    R  I  N  G  -  S  E  R  V  E  R    *
*                                       *
*****************************************

ServerRing	dc.l 0		;server-ring

Reset_RingServer
***********************
*  reset ring-server  *
***********************

	move.l a0,-(a7)
	move.l ServerRing(pc),a0  ;get server-ring
	bsr Delete_Ring		;delete server-ring
	clr.l ServerRing	;reset server-ring
	move.l (a7)+,a0
	rts

Open_Ring
***************
*  open ring  *
***************
;a2,ring

	movem.l d0/a0,-(a7)
	move.l ServerRing(pc),a0  ;get server-ring
	move.l a0,d0		;save first list of server-ring
	beq.s 3$		;there is no server-ring? =yes
2$	cmp.l 8(a0),a2		;entered ring = ring?
	beq.s 1$		;=yes
	move.l (a0),a0		;get next list of server-ring
	cmp.l a0,d0		;all entries checked?
	bne.s 2$		;=no
3$	movem.l (a7)+,d0/a0
	rts
1$	bsr Delete_List		;delete list of entry
	move.l a0,ServerRing	;save server-ring
	bra.s 3$		;end

Close_Ring
***************
*  open ring  *
***************
;a2,ring

	movem.l d0/a0-a1,-(a7)
	move.l ServerRing(pc),a1  ;get server-ring
	moveq #4,d0		;size of entry:= 4
	bsr Add_New_List	;add new list for entry to server-ring
	move.l a2,8(a0)		;set ring in new list
	move.l a0,ServerRing	;save server-ring
	movem.l (a7)+,d0/a0-a1
	rts

*****************************************
*                                       *
*    Q  U  I  C  K  -  S  T  A  C  K    *
*                                       *
*****************************************

;======================================;
;  remark: stack is organized upwards  ;
;======================================;

Test_QuickStack
**************************************
*  get stack-size and stack-pointer  *
**************************************
;a2,quick-stack
;_d0,stack-size
;_d1,stack-pointer (0 <==> stack is empty)

	move.l 4(a2),d0		;get block-size of stack-list
	subq.l #4,d0		;stack-size:= block-size - 4 (pointer)
	move.l 8(a2),d1		;get stack-pointer
	rts

Push_QuickStack
******************************
*  push date on quick-stack  *
******************************
;a0,date
;a2,quick-stack
;_ZF,1 <==> stack-overflow (==> date not pushed)

	move.l d0,-(a7)
	move.l 8(a2),d0		;get stack-offset
	addq.l #4,d0		;stack-offset + 4
	cmp.l 4(a2),d0		;quick-stack full?
	beq.s 1$		;=yes
	move.l a0,8(a2,d0.l)	;push date on quick-stack
	move.l d0,8(a2)		;save stack-offset
1$	movem.l (a7)+,d0
	rts

Pop_QuickStack
*******************************
*  pop date from quick-stack  *
*******************************
;a2,quick-stack
;_a0,date
;_ZF,1 <==> stack-underflow (==> date not popped)

	move.l d0,-(a7)
	move.l 8(a2),d0		;get stack-offset
	beq.s 1$		;stack empty? =yes
	move.l 8(a2,d0.l),a0	;get date from stack
	subq.l #4,8(a2)		;stack-offset - 4
	and #-4-1,ccr		;set "ok"
1$	movem.l (a7)+,d0
	rts

Open_QuickStack
************************
*  open bracket-stack  *
************************
;a0,old quick-stack (not 0 ==> will be deleted)
;d0,size of quick-stack
;_a0,quick-stack

	bsr.s Close_QuickStack	;delete old quick-stack
	addq.l #4,d0		;stack-size + 4 (pointer)
	bsr Install_List	;install list for quick-stack
	clr.l 8(a0)		;reset stack-pointer
	subq.l #4,d0		;get old stack-size
	rts

Close_QuickStack
*************************
*  close bracket-stack  *
*************************
;a0,stack
;_a0,0 (save this as old stack)

	bra Delete_Ring		;delete quick-stack-list


********************************************************
*                                                      *
*    S  T  A  C  K  -  C  O  N  T  R  O  L  L  E  R    *
*                                                      *
********************************************************

Open_Stack
****************
*  open stack  *
****************
;_a0,stack-ring

	move.l d0,-(a7)
	clr.l d0		;install empty list
	bsr Install_List
	move.l (a7)+,d0
	rts

Close_Stack
*****************
*  close stack  *
*****************
;a0,stack-ring (0 ==> stack will not be closed)

	bra Delete_Ring		;delete stack-ring

Push_Stack
************************
*  push date on stack  *
************************
;a0,date
;d0,date-size
;a3,stack-ring

	movem.l a0-a1,-(a7)
	bsr Install_List_Set	;install list of date
	move.l a1,a0		;get installed list
	move.l -4(a3),a1	;get last list of stack
	bsr Add_List		;add list of date to stack
	movem.l (a7)+,a0-a1
	rts

PushL_Stack
*****************************
*  push date-list on stack  *
*****************************
;a0,date-list (this list will be pushed)
;a3,stack-ring

	move.l a1,-(a7)
	move.l -4(a3),a1	;get last list of stack
	bsr Add_List		;add list of date to stack
	move.l (a7)+,a1
	rts

Pop_Stack
*************************
*  pop date from stack  *
*************************
;a0,destination
;d0,date-size
;a3,stack-ring

	movem.l d1/a1,-(a7)
	move.l a3,a1		;list:= first list
	move.l d0,d1		;get date-size
	neg.l d1		;list-offset:= -date-size
	bsr CopyBlock_FromRing	;get block from stack-ring
	bsr Delete_Ring_Block	;delete block in stack-ring
	movem.l (a7)+,d1/a1
	rts

PopL_Stack
******************************
*  pop date-list from stack  *
******************************
;d0,date-size
;a3,stack-ring
;_a0,date-list

	movem.l d1/a1,-(a7)
	move.l a3,a1		;list:= first list
	move.l d0,d1		;get date-size
	neg.l d1		;list-offset:= -date-size
	bsr Remove_Ring_Block	;remove block from stack-ring
	bsr Fuse_Ring		;fuse ring into one list
	movem.l (a7)+,d1/a1
	rts


***********************************************
*                                             *
*    R  I  N  G  -  R  O  U  T  I  N  E  S    *
*                                             *
***********************************************

;-------------------------------------------------------;
;  remark: list-offsets are signed and can exceed list  ;
;-------------------------------------------------------;
;--------------------------------------------------------------------;
;  remark: avoid empty rings concerning routines using list-offsets  ;
;--------------------------------------------------------------------;

Search_Ring_String
*******************************
*  search string within ring  *
*******************************
;a0,string
;d0,string-size (do not use 0)
;a1,start: list
;d1,start: list-offset
;a2,end: list
;d2,end: list-offset
;_a1,position of found string: list
;_d1,position of found string: list-offset
;_d3,position of found string: offset from start
;_ZF,0 <==> string not found
* string will not be compared on end-position *
* exception: start = end ==> search-area is entire ring *

	movem.l d4-d7/a3-a4,-(a7)
	bsr Legal_List_Offset	;legalize list-offset of start
	exg a1,a2		;save start and get end
	exg d1,d2
	bsr Legal_List_Offset	;legalize list-offset of end
	exg a1,a2		;get start and end
	exg d1,d2
	clr.l d3		;reset postion-offset
	move.b (a0),d7		;get first byte of string
6$				;--- compare quickly ---
	cmp.b 8(a1,d1.l),d7	;compare first byte of string
	bne.s 4$		;bytes are equal? =no
				;--- compare string ---
	move.l a1,a4		;save list
	move.l d1,d4		;list-block-offset:= list-offset
	move.l a0,a3		;save string
	move.l d0,d5		;string-counter:= string-size
1$	move.b 8(a4,d4.l),d6	;compare bytes
	cmp.b (a3)+,d6
	bne.s 4$		;bytes are equal? =no
	subq.l #1,d5		;dec string-counter
	beq.s 3$		;string found? =yes
	addq.l #1,d4		;inc list-block-offset
2$	cmp.l 4(a4),d4		;end of list-block?
	bne.s 1$		;=no
5$	move.l (a4),a4		;get next list of ring
	clr.l d4		;list-block-offset:= 0
	bra.s 2$		;continue comparing
4$				;--- inc pointer ---
	addq.l #1,d3		;inc postion-offset
	addq.l #1,d1		;inc ring-pointer
	bsr Legal_List_Offset	;legalize list-offset of start
	cmp.l a1,a2		;list = end-list?
	bne.s 6$		;=no
	cmp.l d1,d2		;list-offset = list-offset of end?
	bne.s 6$		;=no
	and.b #-1-4,ccr		;set "string not found"
3$				;--- string found / end ---
	movem.l (a7)+,d4-d7/a3-a4
	rts

Search_List
************************************
*  search entire list within ring  *
************************************
;a0,list
;a1,ring
;d2,end-list of ring (will not be compared)
;_d0,counted list within ring (0 = first list of ring)
;_a2,found list in ring
;_ZF,1 <==> list not found

	movem.l d1/a1/a3,-(a7)
	clr.l d0		;reset counter of ring-list
	move.l 4(a0),d1		;get size of list-block
2$	cmp.l 4(a1),d1		;size list-block = size ring list-block?
	bne.s 1$		;=no
	move.l a1,a2		;get current ring-list
	addq.l #8,a2		;get block-addr of ring-list
	move.l 8(a0),a3		;get block-addr of list
	bra.s 4$		;start block-comparison
3$	cmp.b (a3)+,(a2)+	;compare block-bytes
	bne.s 5$		;bytes are equal? =no
4$	subq.l #1,d1		;dec block-size
	bpl.s 3$		;complete block compared? =no
	bra.s 6$		;list found
5$	move.l 4(a0),d1		;get size of list-block
1$	addq.l #1,d0		;inc counter of ring-list
	move.l (a1),a1		;get next list of ring
	cmp.l a1,d2		;all lists of ring checked?
	bne.s 2$		;=no
6$	move.l a1,a2		;get current ring-list
	movem.l (a7)+,d1/a1/a3
	rts

CopyBlock_FromRing
**************************
*  copy block from ring  *
**************************
;a1,ring: list
;d1,ring: list-offset
;d0,block-size
;a0,destination-addr

	bsr Legal_List_Offset	;legalize list-offset
	movem.l d0-d2/a0-a2,-(a7)
	move.l a0,a2		;save destination
	bsr Get_RingBlock_Areas	;get areas of ring-block
	exg a1,a2		;get destination and save first entire list
				;--- copy first area ---
	bsr Copy_Mem		;copy first block-area
	add.l d0,a1		;destination + size of first block-area
				;--- copy second area ---
	bra.s 1$		;start copying
2$	move.l 4(a2),d0		;get list-block-size
	lea.l 8(a2),a0		;source:= list-block
	bsr Copy_Mem		;copy list-block
	add.l d0,a1		;destination + list-block-size
	move.l (a2),a2		;get next list
1$	subq.l #1,d1		;dec list-counter
	bpl.s 2$		;end of entire lists? =no
				;--- copy last list ---
	lea.l 8(a2),a0		;source:= list-block
	move.l d2,d0		;get size of last block-area
	bsr Copy_Mem		;copy last block-area
	movem.l (a7)+,d0-d2/a0-a2
	rts

Get_RingBlock_Areas
*****************************
*  get areas of ring-block  *
*****************************
;a1,list
;d1,list-offset
;d0,block-size
;_a0,addr of block-start (within first list)
;_d0,size of first block-area
;_a1,first entire list (=second list of block)
;_d1,number of further lists that are entire part of the block
;_d2,size of last block-area of last list
;_order: (first list: a0,d0) - (entire lists: a1,d1) - (last list: d2)

	move.l d0,d2		;save block-size
	bsr Legal_List_Offset	;legalize list-offset for start
	move.l (a1),-(a7)	;save first entire list
				;--- get first area ---
	lea.l 8(a1,d1.l),a0	;get addr of block-start
	move.l 4(a1),d0		;get block-size of first list
	sub.l d1,d0		;area-size:= list-block-size - list-offset
	clr.l d1		;counter of entire lists:= 0
	sub.l d0,d2		;block-size - area-size
	bhi.s 1$		;block-size <= 0? =no
	add.l d2,d0		;area-size:= old block-size
	clr.l d2		;size of last area:= 0
	bra.s 2$		;end
1$				;--- get medium and last area ---
	move.l (a1),a1		;get next list
	sub.l 4(a1),d2		;block-size - list-block-size
	bls.s 3$		;block-size <= 0? =yes
	addq.l #1,d1		;inc counter of entire lists
	bra.s 1$		;next list
3$	add.l 4(a1),d2		;size of last area:= old block-size
2$	move.l (a7)+,a1		;get first entire list
	rts

Delete_Ring_Block
**************************
*  delete block of ring  *
**************************
;a1,list
;d1,list-offset
;d0,block-size (do not use 0)
;_a1,list after deleted block

	move.l a0,-(a7)
	bsr Remove_Ring_Block	;remove block of ring
	bsr Delete_Ring		;delete removed ring
	move.l (a7)+,a0
	rts

Remove_Ring_Block
***************************************************
*  remove block from ring and link block to ring  *
***************************************************
;a1,list
;d1,list-offset
;d0,block-size (do not use 0)
;_a0,first list of block
;_a1,list after block before removing
;    (= a0 if block-size = ring-size)

	bsr Split_Ring_Block	;split block into lists
	bra Remove_Ring		;remove ring (=block)

Alloc_Ring_Block
********************************
*  allocate block within ring  *
********************************
;a1,list
;d1,list-offset
;d0,block-size
;_a1,list of block (next list = list at set position)
;_order: block - ring:set position - ring:end

	movem.l d2/a0/a2,-(a7)
	bsr Install_List	;install list for block
	move.l a0,a2		;ring2 is installed list
	clr.l d2
	bsr Add_Ring_Pos	;add block (=ring2) to ring
	move.l a2,a1		;get list of block
	movem.l (a7)+,d2/a0/a2
	rts

Add_Ring_Pos
**************************************
*  add ring to ring at any position  *
**************************************
;a1,ring1: list
;d1,ring1: list-offset
;a2,ring2: list
;d2,ring2: list-offset
;_a1,ring1: list at set position
;_a2,ring2: list at set position
;_order: ring1:set position - ring1:end - ring2:set position - ring2:end

	movem.l d1-d2/a0,-(a7)
	clr.l d0		;block-size:= 0
	bsr Split_Ring_Block	;split ring1 at set position
	move.l a2,a1		;prepare "split ring2"
	move.l d2,d1
	move.l a0,d2		;save position in ring1
	bsr Split_Ring_Block	;split ring2 at set position
	move.l d2,a1		;get ring1
	bsr Add_Ring		;add ring
	move.l a0,a2		;get ring2
	movem.l (a7)+,d1-d2/a0
	rts

Fuse_Ring
************************************
*  fuse entire ring into one list  *
************************************
;a0,ring (will be deleted)
;_a0,ring (= one list)

	cmp.l (a0),a0		;ring exists of one list
	beq.s 3$		;=yes
	movem.l d0-d1/a1,-(a7)
	move.l a0,d1		;save first list of ring
	bsr Get_Ring_Size	;get ring-size
				;--- make list of ring ---
	bsr Install_List	;install list (block-size:= ring-size)
	move.l a0,-(a7)		;save installed list
	lea.l 8(a0),a1		;destin-addr:= block-addr of installed list
	move.l d1,a0		;get first list of ring
2$	addq.l #4,a0		;get block-size and block-addr of ring-list
	move.l (a0)+,d0
	bsr Copy_Mem		;copy block of ring-list into list
	add.l d0,a1		;destin-addr + block-size of ring-list
	move.l -8(a0),a0	;get next list of ring
	cmp.l a0,d1		;all lists of ring copied?
	bne.s 2$		;=no
				;--- end ---
	bsr Delete_Ring		;delete old ring
	move.l (a7)+,a0		;get new ring (= list)
	movem.l (a7)+,d0-d1/a1
3$	rts

Delete_Ring
************************
*  delete entire ring  *
************************
;a0,ring (0 ==> no deleting)
;_a0,0

	move.l a0,-4(a7)	;ring does exist?
	bne.s 2$		;=yes
	rts
1$	bsr Delete_List		;delete list
2$	cmp.l (a0),a0		;next list = same list?
	bne.s 1$		;=no
	bra Delete_List		;delete last list of ring

Remove_Ring
***************************
*  remove ring from ring  *
***************************
;a0,ring: list
;a1,ring: end-list (not part of the removed ring)
;_a0,removed ring
;_ZF,1 <==> nonsense: list = end-list
* nonsense (empty ring <==> entire ring) has no effect *

	movem.l a2-a3,-(a7)
	move.l -(a0),a2		;save list before block
	move.l -(a1),a3		;save last list of block
	move.l a2,(a1)+		;link list before block and end-list
	move.l a1,(a2)
	move.l a3,(a0)+		;link first list and last list of block
	move.l a0,(a3)
	movem.l (a7)+,a2-a3
	cmp.l a0,a1		;get nonsense-flag
	rts

Duplicate_Ring
***************************
*  duplicate entire ring  *
***************************
;a0,ring (0 ==> no duplicating)
;_a1,duplicated ring

	movem.l d0/a2,-(a7)
	move.l a0,d0		;save first list of ring
	beq.s 2$		;ring exists? =no
	move.l #0,a2		;set "there is no new ring"
1$	bsr Duplicate_List	;duplicate list
	bsr Add_List_2		;add duplicated list to new ring
	move.l a1,a2		;get new ring
	move.l (a0),a0		;get next list of ring
	cmp.l a0,d0		;entire ring duplicated?
	bne.s 1$		;=no
	move.l a2,a1		;get duplicated ring
2$	movem.l (a7)+,d0/a2
	rts

Add_Ring
**********************
*  add ring to ring  *
**********************
;a0,ring1: list
;a1,ring2: list
;_order: ring1:list - ring1:last list - ring2:list - ring2:last list

	movem.l a2-a3,-(a7)
	move.l -(a0),a2		;save ring1:last list
	move.l -(a1),a3		;save ring2:last list
	move.l a2,(a1)+		;link ring1:last list and ring2:list
	move.l a1,(a2)
	move.l a3,(a0)+		;link ring2:last list and ring1:list
	move.l a0,(a3)
	movem.l (a7)+,a2-a3
	rts

Get_Ring_Size
**********************
*  get size of ring  *
**********************
;a0,ring
;_d0,ring-size

	move.l d1,-(a7)
	move.l a0,d1		;save first list of ring
	clr.l d0		;reset ring-size
1$	add.l 4(a0),d0		;add block-size of list to ring-size
	move.l (a0),a0		;get next list
	cmp.l a0,d1		;all lists of ring checked?
	bne.s 1$		;=no
	move.l (a7)+,d1
	rts

Split_Ring_Block
************************************
*  split block of ring into lists  *
************************************
;a1,list
;d1,list-offset
;d0,block-size (routine will work faster if 0)
;_a0,first list of block
;_a1,list after block (provided that block-size is not 0)

	movem.l d1/a2,-(a7)
	bsr Legal_List_Offset	;legalize list-offset
	move.l a1,a0		;save list in case new offs = 0
	beq.s 1$		;new offset = 0? =yes
	move.l a1,a2		;split list
	bsr Split_List
	move.l (a2),a0		;save start-list
1$	tst.l d0		;block-size = 0?
	beq.s 2$		;=yes
	add.l d0,d1		;add block-size to block-start
	bsr Legal_List_Offset	;legalize list-offset
	beq.s 2$		;new offset = 0? =yes
	move.l a1,a2		;split list
	bsr Split_List
	move.l (a2),a1		;get end-list
2$	movem.l (a7)+,d1/a2
	rts

Legal_List_Offset
*************************************
*  legalize offset-pointer of list  *
*************************************
;a1,list
;d1,list-offset = delta (exceeds list)
;_a1,new list
;_d1,new list-offset (within list)
;_ZF,1 <==> new list-offset = 0
* ring is empty ==> IP will not leave routine *

	tst.l d1
	bpl.s 1$		;delta < 0? =no
				;--- delta < 0 ---
7$	move.l -(a1),a1		;get previous list
	add.l 4(a1),d1		;delta + current block-size
	bmi.s 7$		;overflow? =no
	rts
				;--- delta >= 0 ---
3$	move.l (a1),a1		;get next list
1$	sub.l 4(a1),d1		;delta - current block-size
	bpl.s 3$		;underflow? =no
	add.l 4(a1),d1		;get last delta
	rts

Fuse_Lists
******************************************
*  fuse lists within ring into one list  *
******************************************
;a0,first list
;a1,end-list (not part of the fused lists)
* exception: first list = end-list ==> entire ring will be fused *

	cmp.l a0,a1		;lists are entire ring?
	beq.s 1$		;=yes
	bsr Remove_Ring		;remove lists from ring
	bsr Fuse_Ring		;fuse removed lists into one list
	bra Add_Ring		;add list to ring
1$	bsr Fuse_Ring		;fuse ring
	move.l a0,a1		;end-list:= list
	rts

Delete_List
*****************************************
*  delete list and link adjacent lists  *
*****************************************
;a0,list
;_a0,next list of deleted list (0 <== next list does not exist)

	movem.l d0/a1,-(a7)
	bsr Remove_List		;remove list
	move.l 4(a0),d0		;get block-size of list
	add.l #12,d0		;get list-size
	subq.l #4,a0		;get list-start
	bsr Free_Mem		;free mem of list
	move.l a1,a0		;get next list
	movem.l (a7)+,d0/a1
	rts

Delete_ListEnd
************************
*  delete end of list  *
************************
;a0,list
;d0,size of end

	move.l a0,-(a7)
	sub.l d0,4(a0)		;list-block-size - end-size
	add.l 4(a0),a0		;pointer:= list + new list-block-size
	addq.l #8,a0		;pointer + 8
	bsr Free_Mem		;free mem of list-end
	move.l (a7)+,a0
	rts

Remove_List
*****************************************
*  remove list and link adjacent lists  *
*****************************************
;a0,list
;_a1,next list of removed list (0 <== next list does not exist)

	move.l -4(a0),a1	;get previous list
	move.l (a0),(a1)	;set addr of next list in previous list
	move.l (a0),a1		;get next list
	move.l -4(a0),-4(a1)	;set addr of previous list in next list
	cmp.l a0,a1		;next list = list?
	bne.s 1$		;=no
	move.l #0,a1		;set "next list does not exist"
1$	rts

Duplicate_List
********************
*  duplicate list  *
********************
;a0,list
;_a1,duplicated list

	movem.l d0/a0,-(a7)
	addq.l #4,a0		;get block-size and block-addr of list
	move.l (a0)+,d0
	bsr Install_List_Set	;install list and set block
	movem.l (a7)+,d0/a0
	rts

Add_New_List
**********************************
*  install list and add to list  *
**********************************
;a1,list (0 <==> list will not be added)
;d0,block-size of new list
;_a0,new list
;_order: list - new list - ...

	bsr Install_List	;install new list
	bra Add_List		;add new list to main-list

Add_List
*******************************
*  add list to list and link  *
*******************************
;a1,main-list (0 ==> no adding)
;a0,list, that should be added (insert-list)
;_order: main-list - insert-list - ...

	move.l a1,-4(a7)	;main-list does not exist?
	beq.s 1$		;=yes
	move.l a2,-(a7)
	move.l (a1),a2		;save upper-list
	move.l a1,-4(a0)	;set addr of lower list in insert-list
	move.l a0,(a1)		;set addr of insert-list in lower-list
	move.l a2,(a0)		;set addr of upper list in insert-list
	move.l a0,-(a2)		;set addr of insert-list in upper-list
	move.l (a7)+,a2
1$	rts

Add_List_2
*******************************
*  add list to list and link  *
*******************************
;a2,main-list (0 ==> no adding)
;a1,list, that should be added (insert-list)
;_order: main-list - insert-list - ...

	move.l a2,-4(a7)	;main-list exists?
	beq.s 1$		;=no
	move.l a0,-(a7)
	move.l (a2),a0		;save upper-list
	move.l a2,-4(a1)	;set addr of lower list in insert-list
	move.l a1,(a2)		;set addr of insert-list in lower-list
	move.l a0,(a1)		;set addr of upper list in insert-list
	move.l a1,-(a0)		;set addr of insert-list in upper-list
	move.l (a7)+,a0
1$	rts

Insert_List
****************************************
*  insert list within a list and link  *
****************************************
;a2,main-list
;a1,list, that should be inserted (insert-list)
;d1,offset in main-list

	bsr Split_List		;split main-list
	bra Add_List_2		;add insert-list to lower list

Split_List
****************************************
*  split list into two lists and link  *
****************************************
;a2,list
;d1,size of lower list for splitting

	movem.l d0/a0-a1/a3,-(a7)
	move.l (a2)+,a3		;get next list
;;;;;	move.l (a2),d0		;get list-size
;;;;;	lsr.l #1,d0		;halve list-size
;;;;;	cmp.l d1,d0		;find out bigger part of splitted list
;;;;;	bhs.s 1$		;upper part is bigger? =yes
				;--- lower part is bigger ---
	move.l (a2),d0		;get list-size
	sub.l d1,d0		;get size of upper part
	lea.l 4(a2,d1.l),a0	;get addr of upper part
	bsr Install_List_Set	;install list of upper part
	bsr Free_Mem		;free mem of upper part
	move.l d1,(a2)		;set size of lower part in lower list
	move.l a3,(a1)		;set addr of next list in upper list
	move.l a1,-(a3)		;set addr of upper list in next list
	move.l a1,-(a2)		;set addr of upper list in lower list
	move.l a2,-(a1)		;set addr of lower list in upper list
2$	movem.l (a7)+,d0/a0-a1/a3
	rts
1$				;--- upper part is bigger ---

Install_List_Set
**********************************
*  install a list and set block  *
**********************************
;a0,block-addr
;d0,block-size
;_a1,list

	move.l a0,-(a7)		;save block-addr
	bsr Install_List	;install list
	lea.l 8(a0),a1		;get block-addr of list
	move.l (a7)+,a0		;get block-addr
	bsr Copy_Mem		;copy block into list
	subq.l #8,a1		;get list
	rts

Install_List
******************
*  install list  *
******************
;d0,block-size of list
;_a0,list

	add.l #12,d0		;get list-size
	bsr Alloc_Mem		;alloc mem for list
	sub.l #12,d0		;get block-size
	addq.l #4,a0		;get list
	move.l a0,-4(a0)	;previous list:= list
	move.l a0,(a0)		;next list:= list
	move.l d0,4(a0)		;set block-size in list
	rts

Copy_Mem
***********************
*  copy memory-block  *
***********************
;a0,source-addr
;a1,destination-addr
;d0,block-size
;***  O P T I M I Z E !!!  ***

	movem.l d0/a0-a1,-(a7)
	cmp.l a0,a1		;check on block-overlapping
	bls.s 3$		;destin-addr is upper addr? =no
				;--- destin-addr is upper addr ---
	add.l d0,a0		;add block-size to addrs
	add.l d0,a1
	bra.s 4$
2$	move.b -(a0),-(a1)	;copy downwards
4$	subq.l #1,d0
	bpl.s 2$
	bmi.s 5$		;finished
				;--- destin-addr is lower addr ---
1$	move.b (a0)+,(a1)+	;copy upwards
3$	subq.l #1,d0
	bpl.s 1$
5$	movem.l (a7)+,d0/a0-a1
	rts


***********************************************
*                                             *
*    M  E  M  O  R  Y  -  S  E  R  V  E  R    *
*                                             *
***********************************************

Alloc_Mem
*********************
*  allocate memory  *
*********************
;d0,size
;_a0,addr

	movem.l d0-d1/a1/a6,-(a7)
	move.l $4,a6		;get exec
	clr.l d1		;set "fastmem first"
	jsr -198(a6)		;allocate memory
	move.l d0,a0		;save addr of allocated mem
	movem.l (a7)+,d0-d1/a1/a6
	rts

Free_Mem
*********************
*  allocate memory  *
*********************
;a0,addr (0 ==> no freeing)
;d0,size

	movem.l d0-d1/a0-a1/a6,-(a7)
	move.l $4,a6		;get exec
	move.l a0,d1		;get addr-delta to round off addr
	beq.s 1$		;no mem to free? =yes
	and.b #$07,d1		;(delta:= (8 - (addr and 7)) and 7)
	neg.b d1
	addq.b #8,d1
	and.l #$07,d1
	sub.l d1,d0		;size:= size - addr-delta
	lea.l (a0,d1.w),a1	;get rounded off addr
	jsr -210(a6)		;free memory
1$	movem.l (a7)+,d0-d1/a0-a1/a6
	rts


**************************************
*                                    *
*    D  O  S  -  S  E  R  V  E  R    *
*                                    *
**************************************

;===========================;
;  constants of dos-server  ;
;===========================;

File_Buffer_Size	= 1024		;size of file-buffer

;======================;
;  data of dos-server  ;
;======================;

DosLib_Name	dc.b "dos.library",0	;name of dos-library
		even
Dos_Library	dc.l 0			;addr of dos-library
File_Buffer	dc.l 0			;addr of file-buffer


Open_DOS_Server
*********************
*  open dos-server  *
*********************

	movem.l d0-d3/a0-a1/a6,-(a7)
					;--- open dos-library ---
	move.l $4,a6			;get kickstart
	lea.l DosLib_Name(pc),a1	;get library-name of dos
	clr.l d0			;no special kick-version required
	jsr -552(a6)			;open dos-library
	move.l d0,Dos_Library		;save dos-library
					;--- open file-buffer ---
	move.l #File_Buffer_Size,d0	;get size of filer-buffer
	bsr Alloc_Mem			;allocate mem for file-buffer
	move.l a0,File_Buffer		;save file-buffer
	movem.l (a7)+,d0-d3/a0-a1/a6
	rts

Close_DOS_Server
**********************
*  close dos-server  *
**********************

	movem.l d0-d3/a0-a1/a6,-(a7)
					;--- close dos-library ---
	move.l $4,a6			;get kickstart
	move.l Dos_Library(pc),a1	;get dos-library
	jsr -414(a6)			;close dos-library
					;--- close file-buffer ---
	move.l #File_Buffer_Size,d0	;get size of file-buffer
	move.l File_Buffer(pc),a0	;get file-buffer
	bsr Free_Mem			;free mem of file-buffer
	clr.l File_Buffer		;reset file-buffer
	movem.l (a7)+,d0-d3/a0-a1/a6
	rts

Open_File_New
***********************
*  open new dos-file  *
***********************
;d1,file-name
;_d1,file-identification

	or #16,ccr			;set flag "new file"
	bra.s Open_File			;open file

Open_File_Old
***********************
*  open old dos-file  *
***********************
;d1,file-name
;_d1,file-identification

	and #-1-16,ccr			;set flag "old file"
	bra.s Open_File			;open file
	nop

Open_File
*******************
*  open dos-file  *
*******************
;d1,file-name
;XF,1 <==> new file, 0 <==> old file
;_d1,file-identification

	movem.l d0/d2-d3/a0-a1/a6,-(a7)
	move.l Dos_Library(pc),a6	;get dos-library
	move.l #1005,d2			;sign: old file
	clr.w d0			;set "new file" if xf set
	addx.w d0,d2
	jsr -30(a6)			;open dos-file
	move.l d0,d1			;get file-identification
	movem.l (a7)+,d0/d2-d3/a0-a1/a6
	rts

Close_File
********************
*  close dos-file  *
********************
;d1,file-identification

	movem.l d0-d3/a0-a1/a6,-(a7)
	move.l Dos_Library(pc),a6	;get dos-library
	jsr -36(a6)			;close dos-file
	movem.l (a7)+,d0-d3/a0-a1/a6
	rts

Copy_File_To_Ring
******************************
*  copy entire file to ring  *
******************************
;d1,file-identification
;_a0,ring

	movem.l d0/d2/a1,-(a7)
	clr.l d2			;set "there is no ring"
	bra.s 2$			;start copying
1$	move.l File_Buffer(pc),a0	;get file-puffer
	bsr Install_List_Set		;install list of file-puffer
	move.l a1,a0			;get list of file-puffer
	move.l d2,a1			;get ring
	bsr Add_List			;add list of file-puffer to ring
	move.l a0,d2			;save current list of ring
2$	bsr Read_FileBuffer		;read from file into file-buffer
	tst.l d0			;end of file?
	bne.s 1$			;=no
	move.l (a0),a0			;get ring
	movem.l (a7)+,d0/d2/a1
	rts

Copy_Ring_To_File
******************************
*  copy entire ring to file  *
******************************
;a0,ring
;d1,file-identification

	movem.l d0-d3/a0-a1,-(a7)
	move.l d1,d3			;save file-identification
	bsr Get_Ring_Size		;get size of ring
	move.l d0,d2			;save ring-size
	move.l a0,a1			;set pointer to ring-start
	clr.l d1
	move.l File_Buffer(pc),a0	;get file-buffer
	move.l #File_Buffer_size,d0	;block-size:= file-buffer-size
					;--- write blocks into file ---
2$	sub.l d0,d2			;ring-size - file-buffer-size
	bmi.s 1$			;underflow? =yes
	bsr CopyBlock_FromRing		;copy ring-block into file-buffer
	bsr.s 3$			;write file-buffer to file
	add.l d0,d1			;pointer + file-buffer-size
	bra.s 2$			;write next block
1$	add.l d2,d0			;get size of remaining block
	beq.s 4$			;block-size = 0? =yes
	bsr CopyBlock_FromRing		;copy remaining block into buffer
	bsr.s 3$			;write file-buffer to file
4$	movem.l (a7)+,d0-d3/a0-a1
	rts
3$					;--- write buffer to file ---
	exg d1,d3			;get file-identification
	bsr Write_FileBuffer		;write file-buffer to file
	exg d1,d3			;save file-identification
	rts

Read_FileBuffer
*************************************
*  read from file into file-buffer  *
*************************************
;d1,file-identification
;_d0,number of bytes read actually

	movem.l d1-d3/a0-a1/a6,-(a7)
	move.l Dos_Library(pc),a6	;get dos-library
	move.l File_Buffer(pc),d2	;get file-buffer
	move.l #File_Buffer_Size,d3	;get buffer-size
	jsr -42(a6)			;read from file into file-buffer
	movem.l (a7)+,d1-d3/a0-a1/a6
	rts

Write_FileBuffer
*******************************
*  write file-buffer to file  *
*******************************
;d1,file-identification
;d0,number of bytes

	movem.l d0-d3/a0-a1/a6,-(a7)
	move.l Dos_Library(pc),a6	;get dos-library
	move.l File_Buffer(pc),d2	;get file-buffer
	move.l d0,d3			;get buffer-size
	jsr -48(a6)			;write file-buffer to file
	movem.l (a7)+,d0-d3/a0-a1/a6
	rts


********************************
*                              *
*    D  E  B  U  G  G  E  R    *
*                              *
********************************

Open_Debugger
*******************
*  open debugger  *
*******************

	movem.l d0-d3/a0-a3/a6,-(a7)
	clr.l debug_out_pointer
	move.l $4,a6			;OPEN DOS_LIBRARY
	lea.l debug_dos_lib(pc),a1
	clr.l d0
	jsr -552(a6)
	move.l d0,debug_dos_library
	move.l d0,a6
	lea.l debug_filename(pc),a1	;OPEN FILE
	move.l a1,d1
	move.l #1006,d2
	jsr -30(a6)
	move.l d0,debugger_file
	bne.s 1$
	jsr -132(a6)			;GET ERROR
1$	movem.l (a7)+,d0-d3/a0-a3/a6
	rts

Close_Debugger
********************
*  close debugger  *
********************

	movem.l d0-d3/a0-a3/a6,-(a7)
	bsr debug_puffer_to_file
	move.l debug_dos_library(pc),a6	;CLOSE FILE
	move.l debugger_file,d1
	jsr -36(a6)
	move.l a6,a1			;CLOSE DOS_LIBRARY
	move.l $4,a6
	jsr -414(a6)
	movem.l (a7)+,d0-d3/a0-a3/a6
	rts

Debug_Ring
****************
*  debug ring  *
****************
;a0,ring

	movem.l d0-d1/a0,-(a7)
	bsr debug_out_text
	dc.b lf
	dc.b "********************",lf
	dc.b "*  RING: ",0
	even
	move.l a0,d0
	bsr debug_out_lword
	bsr debug_out_text
	dc.b "  *",lf
	dc.b "********************",lf,0
	even
	move.l a0,d0
	moveq #15,d1
2$	bsr debug_out_list
	move.l (a0),a0
	cmp.l a0,d0
	beq.s 1$
	dbra d1,2$
1$	movem.l (a7)+,d0-d1/a0
	rts

debug_out_list
;a0,list

	movem.l d0-d1/a0,-(a7)
	move.l a0,d0
	bsr debug_out_lword
	bsr debug_out_text
	dc.b ": ",0
	even
	move.l -4(a0),d0
	bsr debug_out_lword
	bsr debug_out_space
	move.l (a0)+,d0
	bsr debug_out_lword
	bsr debug_out_space
	move.l (a0)+,d0
	bsr debug_out_lword
	bsr debug_out_space
	bsr debug_out_text
	dc.b lf,"  ",0
	even
	moveq #15,d1
1$	move.b (a0)+,d0
	bsr debug_out_byte
	bsr debug_out_space
	dbra d1,1$
	bsr debug_out_text
	dc.b lf,0
	even
	movem.l (a7)+,d0-d1/a0
	rts

debug_out_text
;pc stacked,text-addr

	movem.l d0/a0,-(a7)
	move.l 8(a7),a0
2$	move.b (a0)+,d0
	beq.s 1$
	bsr debug_out_char
	bra.s 2$
1$	move.l a0,d0
	addq.l #1,d0
	and.b #$fe,d0
	move.l d0,8(a7)
	movem.l (a7)+,d0/a0
	rts

debug_out_lword
;d0,lword

	bsr.s 1$
	bsr.s 1$
	bsr 1$
1$	rol.l #8,d0
debug_out_byte
;d0,byte

	rol.b #4,d0
	bsr 1$
	rol.b #4,d0
1$
	move.w d0,-(a7)
	and.w #$0f,d0
	move.b 2$(pc,d0.w),d0
	bsr debug_out_char
	move.w (a7)+,d0
	rts
2$	dc.b "0123456789abcdef"

debug_out_space

	bsr debug_out_text
	dc.b " ",0
	even
	rts

debug_puffer_to_file

	movem.l d0-d3/a0-a3/a6,-(a7)
	move.l debug_out_pointer(pc),d3	;WRITE PUFFER
	beq.s 1$
	clr.l debug_out_pointer
	lea.l debug_puffer(pc),a0
	move.l a0,d2
	move.l debugger_file(pc),d1
	move.l debug_dos_library(pc),a6
	jsr -48(a6)
1$	movem.l (a7)+,d0-d3/a0-a3/a6
	rts
	
debug_out_char
;d0,char

	move.l a0,-(a7)
	lea.l debug_puffer(pc),a0
	add.l debug_out_pointer(pc),a0
	move.b d0,(a0)
	addq.l #1,debug_out_pointer
	cmp.l #debug_puffer_size,debug_out_pointer
	bne.s 1$
	bsr debug_puffer_to_file
1$	move.l (a7)+,a0
	rts

lf	= $c
debug_puffer_size	= 256
debug_out_pointer	dc.l 0
debugger_file		dc.l 0
debug_dos_library	dc.l 0
debug_puffer		ds.b debug_puffer_size

debug_dos_lib		dc.b "dos.library",0
debug_filename		dc.b "ram:DEBUG",0
	even


	END