;***************************** ;* server * ;* ------ * ;* ( ein Assemblercode zur * ;* unterstützung von * ;* analyse V 3.01 ) * ;* * ;* Version 1.11 25.08.1989 * ;***************************** ;*** Exec - Routinen allocmem = -198 freemem = -210 findtask = -294 allocsig = -330 freesig = -336 addport = -354 remport = -360 getmsg = -372 replymsg = -378 waitport = -384 oopenlibrary = -408 closelibrary = -414 ;*** Mathffp - Funktionen spflt = -036 spcmp = -041 sptst = -048 spadd = -066 spsub = -072 spmul = -078 spdiv = -084 ;*** Mathtrans - Funktionen spatan = -030 spsin = -036 spcos = -042 sptan = -048 spsinh = -060 spcosh = -066 sptanh = -072 spexp = -078 splog = -084 sppow = -090 spsqrt = -096 spasin = -114 spacos = -120 splog10 = -126 ;*** sonstige Label execbase = 004 job_funktion = 000 ;Code Funktionswert berechnen job_codegen = 001 ;Code Ausdruck kompilieren job_codeloe = 002 ;Code Codespeicher freigeben job_codeanf = 003 ;Code Codespeicher anfordern job_kill = 004 ;Code server beenden job_vnfchn = 005 ;Code Ausdruck vereinfachen dstuppad = 020 ;Offset Portadresse in Message dstartup_ok = 024 ;Offset Ok-Feldes in Message pr_msgport = 092 size = 1024 ;Größe Codestruktur in Bytes dptr = 020 ;Offset Knotenzeigers dx = 024 ;Offset x dy = 028 ;Offset y dz = 032 ;Offset z dcode = 036 ;Offset Codezeiger djob = 040 ;Offset Jobcodes derro = 041 ;Offset Rückmeldung dflerg = 042 ;Offset Ergebnisses dlinks = 000 ;Offset des linken Zeigers drechts = 004 ;Offset des rechten Zeigers dinvers = 008 ;Offset der Inversflagge dtyp = 009 ;Offset des Knotentypes dop = 010 ;Offset der Operation dfknt = 010 ;Offset der Funktion dvar = 010 ;Offset der Variablen dfloat = 010 ;Offset der reellen Zahl dganz = 010 ;Offset der ganzen Zahl knotenlange = 014 ;Anzahl Bytes für einen Knoten fknt = 001 ;Code für Funktionsknoten reellknt = 002 ;Code für Reellzahlknoten ganzknt = 003 ;Code für Ganzzahlknoten varknt = 004 ;Code für Variablenknoten malcode = 002 ;Code für Multiplikation potenz = 004 ;Code für Potentierung MEMF_CLEAR = $10000 ;Code für leeren Speicher anfordern ;*** Opcodes: libsprung = $4eaa ;Opcode für jsr 16bit (a2) push = $2f00 ;Opcode für move.l d0 , -(sp) pop = $221f ;Opcode für move.l (sp)+ , d1 movd0d1 = $2200 ;Opcode für move.l d0 , d1 expmov = $323c ;Opcode für move.w #16bit , d1 ;*** Der Spaß geht los run: move.l execbase , a6 suba.l a1 , a1 ;Zeiger auf jsr findtask (a6) ;eigenen Task besorgen move.l d0 , a5 ;Zeiger retten move.l d0 , mp_sigtask ;Kommando Msgport init moveq #-1 , d0 ;nächstes freies jsr allocsig (a6) ;Signalbit anfordern move.b d0 , mp_sigbit ;und im Port vermerken lea pr_msgport (a5) , a5 ;Addresse Msgport berechnen move.l a5 , a0 ;Auf die Startup - Message jsr waitport (a6) ;warten move.l a5 , a0 ;Die Startup - Message jsr getmsg (a6) ;abholen move.l d0 , a3 ;Zeiger auf Message move.l dstuppad (a3) , xarray;Adresse Variablenarray merken move.l #port , dstuppad (a3) ;Zeiger auf Kommandoport in Retmsg lea mathtransname (pc),a1 ;Mathtrans - Library jsr oopenlibrary (a6) ;öffnen move.l d0 , a5 ;Mathtrans - Basisadresse move.l d0 , mathbase ;retten um Register zu sparen bne.s ok ;Ok. Mathtrans geöffnet ;*** fataler Fehler: Mathtrans - Library geht nicht auf ;*** Fehler in Startup - Message schreiben und diverse ;*** Resourcen freigeben. st dstartup_ok (a3) ;Fehlerflag in Startup - Msg reterror: clr.l d0 ;Langwortformat für Betr. syst. move.b mp_sigbit (pc) , d0 ;Signalbitnr. f. Kommandoport jsr freesig (a6) ;Signalbit freigeben move.l a3 , a1 ;Adresse Startup - Message jmp replymsg (a6) ;antworten ok: lea mathffpname (pc) , a1 ;MathFFP - Library jsr oopenlibrary (a6) ;öffnen move.l d0 , a4 move.l a3 , a1 ;Adresse Startup - Message jsr replymsg (a6) ;antworten ;*** Hier beginnt die Hauptschleife loop: lea port (pc) , a0 ;Zeiger auf Kommandoport jsr waitport (a6) ;auf Auftrag warten lea port (pc) , a0 jsr getmsg (a6) ;Auftrag abholen move.l d0 , a3 ;Zeiger auf Message clr.b derro (a3) ;Fehlerflagge in Message move.b djob (a3) , d0 ;Auftragscode aus Msg holen bne.s examine ;keine Fktwertberechnung ;*** Funktionswertberechnung movem.l dx (a3) , d5-d7/a0 ;Variablen und Codeadresse laden pea (a3) ;Zeiger auf Message, a3 freimachen move.l xarray (pc) , a3 ;Zeiger auf Variablenfeld move.l sp , a6 ;Stackpointer retten lea mylib (pc) , a2 ;Basisadresse der mylib move.l #$80000041 , d3 ;Fließkomma 1 jsr (a0) ;Ausdruck berechnen move.l (sp)+ , a3 ;Zeiger auf Message restaurieren move.l d0 , dflerg (a3) ;Ergebniss in Msg eintragen retmsg: move.l execbase , a6 ;a6 war Rechenstackpointer retmsg2: move.l a3 , a1 ;Kommandomessage jsr replymsg (a6) ;zurückschicken bra.s loop ;auf nächstes Kommando warten fwerthandler: move.l a6 , sp ;Errorhandler wurde durch bra aktiv move.l (sp)+ , a3 ;Zeiger auf Message restaurieren st derro (a3) ;Fehlerflagge in Msg setzen bra.s retmsg ;und diese zurückschicken examine: cmp.b #job_codegen , d0 beq.s codegen ;Codestruktur erzeugen cmp.b #job_codeloe , d0 beq.s codeloe ;Speicher für Code freigeben cmp.b #job_codeanf , d0 beq.s codeanf ;Speicher für Code anfordern cmp.b #job_kill , d0 beq.s kill ;server beenden vnfchn: move.l dptr (a3) , a2 ;Zeiger auf Vaterknoten pea (a3) ;Zeiger auf Kommandomessage retten bsr.s winmulti ;Ausdruck in Multibaum wandeln bsr.s winbin ;Multibaum in Binärbaum wandeln move.l (sp)+ , a3 ;Zeiger auf Kommandomessage rückholen move.l a2 , dptr (a3) ;vereinfachten Baum zurückgeben bra.s retmsg2 kill: move.l a5 , a1 ;Mathtrans - Library jsr closelibrary (a6) ;schließen move.l a4 , a1 ;MathFFP - Library jsr closelibrary (a6) ;schließen und Prozeß beenden bra.s reterror ;Message beantworten und Ende codeanf: move.l #size , d0 clr.l d1 ;keine Anforderungen jsr allocmem (a6) move.l d0 , dcode (a3) seq derro (a3) ;kein Speicher, => Fehlerflag bra.s retmsg2 codeloe: move.l #size , d0 ;Speicher freigeben move.l dcode (a3) , a1 jsr freemem (a6) bra.s retmsg2 codegen: move.l dptr (a3) , a6 ;a6: Zeiger auf Wurzelknoten move.l dcode (a3) , a5 ;a5: Zeiger auf Codebereich move.w #size , d4 ;Größe des Codespeichers move.l sp , d3 ;retten für JMP aus Rekursion bsr.s coderek ;code erzeugen subq.w #2 , d4 ;Ist noch Platz für ein RTS im Code ? bcs.s ueberlauf ;Nein! move.w #"Nu" , (a5)+ ;RTS - Code in Code schreiben restore: move.l mathbase (pc) , a5 ;Die verwendeten Register restaurieren bra.s retmsg ueberlauf: move.l d3 , sp ;Rekursionsabbruch durch alten Stack st derro (a3) ;Fehlerflagge in Kommandomessage bra.s restore ;weiter mit Register restaurieren coderek: move.l a6 , d0 ;Flags für Knotenzeiger bne.s cont rts cont: move.b dtyp (a6) , d0 ;Typ des Vaterknotens holen cmpi.b #reellknt , d0 ;ist es ein Terminalknoten ? bmi.s nichtterminal ;nein clr.b d1 ;Code erzeugen, der den Terminal- bra.s terminal ;knoten nach d0 movet nichtterminal: tst.b d0 ;ist es ein Operationsknoten ? bne.s fknoten ;nein. => Funktionsknoten ! ;*** Auswertung eines Operationsknotens move.l drechts (a6) , a0 ;Zeiger auf rechten Sohn move.b dtyp (a0) , d0 ;Typ des rechten Sohnes cmpi.b #reellknt , d0 ;ist rechter Sohn Terminalknoten ? bmi.s rechtsnterm ;nein ;*** Der rechte Sohn ist ein Terminalknoten move.b dop (a6) , d0 ;Operation im Vaterknoten holen cmpi.b #potenz , d0 ;ist es die Potentierung ? bne.s notspezipot ;nein move.b dtyp (a0) , d0 ;Typ des Exponenten holen cmpi.b #ganzknt , d0 ;ist der Exponent ganzzahlig ? bne.s notspezipot ;nein ;*** Code fuer die spezielle Potentierung erzeugen move.w dganz (a0) , -(sp) ;Exponent auf dem Stack sichern move.l (a6) , a6 ;Zeiger auf den linken Sohn holen bsr.s coderek ;Code fuer den linken Sohn erzeugen subq.w #8 , d4 ;noch Platz fuer spezielle Potenzierung ? bcs.s ueberlauf ;nein move.w #expmov , (a5)+ ;Befehl, der den Exp. nach d1 movet move.w (sp)+ , (a5)+ ;Exponenten als Direktoperant einfuegen move.w #libsprung , (a5)+ ;Befehl zum Library - Aufruf move.w #5*4 , (a5)+ ;Offset fuer spezipot - Aufruf rts notspezipot: pea (a6) ;Adresse Vaterknoten retten pea (a0) ;Adresse rechter Sohn retten move.l (a6) , a6 ;Adresse des linken Sohnes bsr.s coderek ;Code für linken Sohn erzeugen move.l (sp)+ , a6 ;Zeiger auf den rechten Sohn move.b dtyp (a6) , d0 ;Typ des Terminalknotens moveq #1 , d1 ;Code für bsr.s terminal ;Terminalknoten => d1 erzeugen move.l (sp)+ , a6 ;Zeiger auf Vaterknoten bra.s opcode ;Code für Verknüpfung generieren ;*** Der rechte Sohn ist kein Terminalknoten rechtsnterm: move.l (a6) , a1 ;Adresse des linken Sohnes move.b dtyp (a1) , d0 ;Typ des linken Sohnes cmpi.b #reellknt , d0 ;ist linker Sohn Terminalknoten bmi.s keintermk ;keiner der Söhne ist ein T.knoten ;*** Der linke Sohn ist ein Terminalknoten pea (a6) ;Adresse des Vaters retten move.l a0 , a6 ;Zeiger auf rechten Sohn bsr.s coderek ;Code für rechten Sohn generieren move.l (sp) , a6 ;Adresse des Vaters zurückholen move.b dop (a6) , d2 ;Verknüpfung kommutativ ? beq.s kommutativ ;plus ist kommutativ cmpi.b #malcode , d2 ;Verknüpfung 'mal' beq.s kommutativ ;ist auch kommutativ ;*** Verknüpfung im Vaterknoten ist nicht kommutativ subq.w #2 , d4 ;Versuch move.l d0 , d1 bcs.s ueberlauf ;anzuhängen move.w #movd0d1 , (a5)+ ;Code erzeugen clr.l d1 ;linker Terminalknoten nach d0 bra.s vatercode ;Code für Verknüpfung erzeugen kommutativ: moveq #1 , d1 ;linken Terminalknoten nach d1 vatercode: move.l (a6) , a6 ;Zeiger auf linken Sohn besorgen move.b dtyp (a6) , d0 ;Terminalknotentyp bsr.s terminal move.l (sp)+ , a6 ;Zeiger auf Vater zurückholen bra.s opcode keintermk: pea (a6) ;Zeiger auf Vaterknoten retten move.l drechts(a6) , a6 ;Zeiger auf rechten Sohn bsr.s coderek ;Code für rechten Sohn erzeugen subq.w #2 , d4 ;noch Platz für ein Push ? bcs.s ueberlauf ;nein ! move.w #push , (a5)+ ;Code für push schreiben move.l (sp) , a6 ;Zeiger auf Vater zurückholen move.l (a6) , a6 ;Zeiger linken Sohn holen bsr.s coderek ;Code für linken Sohn erzeugen subq.w #2 , d4 ;noch Platz für Pop ? bcs.s ueberlauf ;nein ! move.w #pop , (a5)+ ;Code für Pop schreiben move.l (sp)+ , a6 ;Zeiger auf Vater zurückholen opcode: move.b dop (a6) , d0 ;Um welche Operation handelt es sich subq.w #4 , d4 ;noch Platz für Verknüpfung ? bcs.s ueberlauf ;nein ! ext.w d0 ;zu 16 - Bit Index machen lsl.w #2 , d0 ;Index in mylib move.w #libsprung , (a5)+ ;Sprungbefehl für mylib-Aufruf move.w d0 , (a5)+ ;Offset für mylib-Aufruf rts fknoten: pea (a6) ;Zeiger auf Vaterknoten retten move.l (a6) , a6 ;Zeiger auf Argument der Funktion bsr.s coderek ;Code für das Argument erzeugen move.l (sp)+ , a6 ;Zeiger auf Vater zurückholen subq.w #4 , d4 ;noch Platz für Funktionsaufruf bcs.s ueberlauf ;nein ! move.b dfknt (a6) , d0 ;Operationscode aus Knoten holen ext.w d0 ;zu 16 - Bit Index machen addq.w #6 , d0 lsl.w #2 , d0 ;Index in mylib move.w #libsprung , (a5)+ ;Sprungbefehl für mylib-Aufruf move.w d0 , (a5)+ ;Offset für mylib-Aufruf rts terminal: tst.b d1 ;Tabellenbasis bne.s datenreg1 ;gemäß lea tabelle0 (pc) , a2 ;Zieldatenregister bra.s tabellegewaehlt datenreg1: lea tabelle1 (pc) , a2 ;laden tabellegewaehlt: cmpi.b #varknt , d0 ;Variable laden ? bne.s kvarknt ;nein clr.w d0 ;Variablennummer auf 16 Bit move.b dvar (a6) , d0 ;setzen für indizierten Zugruff cmpi.b #253 , d0 ;x , y , z oder indizierte x Variable? bcs.s x_indiziert subq.w #2 , d4 ;Länge Move Befehl für x , y , z bcs.s ueberlauf subi.w #253 , d0 ;richtigen Movebefehl für x , y , z lsl.w #1 , d0 ;indizieren move.w 0 (a2 , d0.w) , (a5)+ ;und in Code schreiben rts x_indiziert: subq.w #4 , d4 ;Länge des Movebefehls für indizierte bcs.s ueberlauf ;Variable move.w 12 (a2) , (a5)+ ;Movebefehl in Code schreiben lsl.w #2 , d0 ;1 Variable braucht 4 Bytes move.w d0 , (a5)+ ;Offset für Movebefehl rts kvarknt: subq.w #6 , d4 ;Platz für Konstantenmove frei ? bcs.s ueberlauf ;nein ! move.w 6(a2) , (a5)+ ;Konstantenmovebefehl übertragen cmpi.b #reellknt , d0 beq.s reellzahl ;Reellzahlknoten ganzzahlknoten: move.w dganz (a6) , d0 ;Ganzzahl aus dem Knoten holen ext.l d0 jsr spflt (a4) ;nach Fließkomma konvertieren move.l d0 , (a5)+ ;und als Konstante ablegen rts reellzahl: move.l dfloat (a6) , (a5)+ ;Reellzahl als Konstante ablegen rts tabelle0: move.l d5 , d0 ;x Wert in float Akku 0 move.l d6 , d0 ;y Wert in float Akku 0 move.l d7 , d0 ;z Wert in float Akku 0 move.l #$12345678 , d0 ;konstante Zahl in float Akku 0 move.l $1234 (a3) , d0 ;indizierte Variable in float Akku 0 tabelle1: move.l d5 , d1 ;x Wert in float Akku 1 move.l d6 , d1 ;y Wert in float Akku 1 move.l d7 , d1 ;z Wert in float Akku 1 move.l #$12345678 , d1 ;konstante Zahl in float Akku 1 move.l $1234 (a3) , d1 ;indizierte Variable in float Akku 1 mylib: ;*** operationen bra.L add bra.L sub bra.L mul bra.L div bra.L pow bra.L spezipot ;** funktionen bra.L sinh bra.L cosh bra.L tanh bra.L coth bra.L arsinh bra.L arcosh bra.L artanh bra.L arcoth bra.L sin bra.L cos bra.L tan bra.L cot bra.L arcsin bra.L arccos bra.L arctan bra.L arccot bra.L exp bra.L ln bra.L log bra.L pot10 bra.L wrzl bra.L quad errorhandler: move.l handler (pc) , a0 ;jeweiligen Handler heraussuchen jmp (a0) ;und anspringen add: jsr spadd (a4) bvs.s errorhandler rts sub: jsr spsub (a4) bvs.s errorhandler rts mul: jsr spmul (a4) bvs.s errorhandler rts div: tst.l d1 beq.s errorhandler jsr spdiv (a4) bvs.s errorhandler rts pow: jsr sppow (a5) bvs.s errorhandler rts sinh: jsr spsinh (a5) bvs.s errorhandler rts cosh: jsr spcosh (a5) bvs.s errorhandler rts tanh: jsr sptanh (a5) bvs.s errorhandler rts coth: jsr sptanh (a5) tst.l d0 beq.s errorhandler move.l d0 , d1 move.l d3 , d0 jsr spdiv (a4) bvs.s errorhandler rts arsinh: move.l d0 , d2 move.l d0 , d1 jsr spmul (a4) bvs.s errorhandler move.l d3 , d1 jsr spadd (a4) jsr spsqrt (a5) move.l d2 , d1 jsr spadd (a4) jmp splog (a5) arcosh: move.l d0 , d2 move.l d0 , d1 jsr spmul (a4) bvs.s errorhandler move.l d3 , d1 jsr spsub (a4) jsr spsqrt (a5) bvs.s errorhandler move.l d0 , d1 move.l d2 , d0 jsr spsub (a4) jsr splog (a5) bvs.s errorhandler andi.b #$7f , d0 rts artanh: move.l d0 , d2 move.l d3 , d1 jsr spadd (a4) move.l d0 , d4 move.l d2 , d1 move.l d3 , d0 jsr spsub (a4) move.l d0 , d1 beq.s errorhandler move.l d4 , d0 jsr spdiv (a4) jsr splog (a5) bvs.s errorhandler move.l #$80000042 , d1 jmp spdiv (a4) arcoth: move.l d0 , d2 move.l d3 , d1 jsr spadd (a4) move.l d0 , d4 move.l d2 , d0 move.l d3 , d1 jsr spsub (a4) move.l d0 , d1 beq.s errorhandler move.l d4 , d0 jsr spdiv (a4) jsr splog (a5) bvs.s errorhandler move.l #$80000042 , d1 jmp spdiv (a4) sin: jsr spsin (a5) bvs.s errorhandler rts cos: jsr spcos (a5) bvs.s errorhandler rts tan: jsr sptan (a5) bvs.s errorhandler rts cot: jsr sptan (a5) beq.s errorhandler move.l d0 , d1 move.l d3 , d0 jsr spdiv (a4) bvs.s errorhandler rts arcsin: jsr spasin (a5) bvs.s errorhandler rts arccos: jsr spacos (a5) bvs.s errorhandler rts arctan: move.l d0 , d2 move.l d0 , d1 jsr spmul (a4) move.l d3 , d1 jsr spadd (a4) jsr spsqrt (a5) move.l d0 , d1 move.l d2 , d0 jsr spdiv (a4) jmp spasin (a5) arccot: move.l d0 , d2 move.l d0 , d1 jsr spmul (a4) move.l d3 , d1 jsr spadd (a4) jsr spsqrt (a5) move.l d0 , d1 move.l d2 , d0 jsr spdiv (a4) jmp spacos (a5) exp: jsr spexp (a5) bvs.s errorhandler rts ln: jsr splog (a5) bvs.s errorhandler rts log: tst.b d0 bmi.s errorhandler jsr splog10(a5) rts pot10: move.l d0 , d1 move.l #$a0000044 , d0 jsr sppow (a5) bvs.s errorhandler rts wrzl: jsr spsqrt (a5) bvs.s errorhandler rts quad: move.l d0 , d1 jsr spmul (a4) bvs.s errorhandler rts spezipot: move.l d5 , -(sp) ;x - Wert retten move.w d1 , d5 ;Exponent wird bitweise zerlegt ext.l d5 ;Vorzeicheninformation retten bpl.s ueberhuepf ;16 - Bit - Exponent positiv machen neg.w d5 ueberhuepf: lsr.w #1 , d5 ;Wie soll das Ergebnissfeld bcs.s startmitx ;initialisiert werden ? startmit1: move.l d3 , d4 ;mit einer Fliesskomma bra.s startpot ;eins ! startmitx: move.l d0 , d4 ;mit der Basis ! startpot: tst.w d5 ;noch Potenzen dazuzumultiplizieren ? beq.s schleifend ;nein ! move.l d0 , d1 ;Zwischenergebniss jsr spmul (a4) ;quadrieren bvs.s errorhandler lsr.w #1 , d5 ;Zwischenergebniss zum End- bcc.s startpot ;ergebniss dazumultiplizieren ? nein ! move.l d0 , d2 ;ja: Zwischenergebniss retten move.l d4 , d1 ;Zum Ergebniss jsr spmul (a4) ;dazumultiplizieren bvs.s errorhandler move.l d0 , d4 ;Ergebniss sichern move.l d2 , d0 ;Zwischenergebniss zurueckholen bra.s startpot ;weitermachen schleifend: move.l d4 , d0 ;Ergebniss immer in d0 liefern ! tst.l d5 ;war der Exponent negativ bne.s reziprok ;ja, dann Kehrwert bilden move.l (sp)+ , d5 ;x - Wert zurueckschreiben rts reziprok: move.l d4 , d1 ;Ergebniss zum Nenner machen beq.s errorhandler ;Division durch 0 abfangen move.l d3 , d0 ;Zaehler gleich 1 jsr spdiv (a4) ;Kehrwert berechnen bvs.s errorhandler move.l (sp)+ , d5 ;x - Wert zurueckschreiben rts winmulti: move.l a2 , d0 ;Wurde ein leerer Baum übergeben? beq.s ewinmulti ;ja => keine Aktion durchführen move.b dtyp (a2) , d0 ;Typ des Vaterknotens holen beq.s multiopknt ;Operationsknoten ( Verknüpfung ) multirek: pea (a2) ;Vater retten wegen postfix Rekursion move.l (a2) , a2 ;Zeiger auf linken Sohn stellen bsr.s winmulti ;linken Sohn wandeln move.l (sp) , a0 ;Zeiger auf ursprünglichen Vater move.l a2 , (a0)+ ;linken Sohn einhängen move.l (a0) , a2 ;rechten Sohn auswählen bsr.s winmulti ;rechten Sohn wandeln move.l (sp)+ , a0 ;ursprünglichen Vater rückholen move.l a2 , drechts (a0) ;rechten Sohn einhängen move.l a0 , a2 ;Zeiger auf Vater ewinmulti: rts ;zurückgeben multiopknt: move.b dop (a2) , d2 ;Verknüpfung im Vater holen cmpi.b #potenz , d2 ;Potenzierung? beq.s multirek ;Potenzierung wird nicht gewandelt andi.b #$FE , d2 ;ermitteln ob additiv, multiplikativ move.b d2 , -(sp) ;retten wegen Rekursion clr.b d3 ;Inversflagge zurücksetzen suba.l a3 , a3 ;Listenkopf leeren bsr.s samloplst ;d2 : operation d2 : Inversflag ;a2 : Vater a3 : Listenkopf moveq #knotenlange , d0 ;Speicher für Multiheader move.l #MEMF_CLEAR , d1 ;vorinitialisierten Operationsknoten jsr allocmem (a6) ;anfordern move.l d0 , a2 ;Zugriff auf neuen Multiheader move.b (sp)+ , dop (a2) ;Verknüpfung in Multiheader eintragen move.l a3 , (a2) ;Operandenliste einhängen rts samloplst: move.b dtyp (a2) , d0 ;Typ des Vaterknotens holen bne.s nichtinvers ;Vater ist kein Operationsknoten move.b dop (a2) , d0 ;Verknüpfung im Vater holen cmp.b d2 , d0 ;ist es die Suchoperation? bne.s sonstigeop ;nein pea (a2) ;Zeiger auf Vaterknoten retten move.l (a2) , a2 ;Zeiger auf linken Sohn besorgen bsr.s samloplst ;Operanden im linken Sohn einketten move.l (sp) , a2 ;Zeiger auf Vater move.l drechts (a2) , a2 ;Zeiger auf rechten Sohn besorgen bsr.s samloplst ;Operanden im rechten Sohn einketten move.l (sp)+ , a1 ;Zeiger auf Vater moveq #knotenlange , d0 ;Vaterknoten freigeben und jmp freemem (a6) ;Ende sonstigeop: eor.b d2 , d0 ;Vater hat inverse Verknüpfung? cmpi.b #1 , d0 bne.s nichtinvers ;Nein. Andere Verknüpfung pea (a2) ;Zeiger auf Vater retten move.l (a2) , a2 ;Zeiger auf linken Sohn bsr.s samloplst ;Operanden im linken Sohn einketten move.l (sp) , a2 ;Zeiger auf Vater zurückholen move.l drechts (a2) , a2 ;Zeiger auf rechten Sohn besorgen not.b d3 ;recht Unteroperanden sind invers bsr.s samloplst ;Operanden im rechten Sohn einketten not.b d3 ;Inversflagge wieder herstellen move.l (sp)+ , a1 ;Zeiger auf Vater zurückgewinnen moveq #knotenlange , d0 ;Vaterknoten freigeben und jmp freemem (a6) ;Ende nichtinvers: pea (a3) ;Listenkopf sichern move.b d3 , -(sp) ;Inversflagge sichern move.b d2 , -(sp) ;Verknüpfung sichern bsr.s winmulti move.b (sp)+ , d2 ;Verknüpfung zurück move.b (sp)+ , d3 ;Inversflagge zurück move.l (sp)+ , a3 ;Listenkopf zurück move.l a3 , drechts (a2) ;Vaterknoten in Liste move.l a2 , a3 ;einketten move.b d3 , dinvers (a3) ;Inversflagge für Vaterknoten setzen rts winbin: move.l a2 , d0 ;Wenn Zeiger gleich nil beq.s ewinbin2 ;dann Ende move.b dtyp (a2) , d0 ;Typ des Vaterknotens bne.s no_opknt ;Vater ist kein Operationsknoten move.b dop (a2) , d2 ;Operation im Vaterknoten besorgen cmpi.b #potenz , d2 ;Potenzierung? beq.s no_opknt ;liegt bereits binär vor move.b d2 , -(sp) ;lokale Variable schützen eori.b #1 , d2 ;inverse Operation ermitteln move.b d2 , -(sp) ;lokale Variable schützen move.l (a2) , a3 ;Zeiger auf ersten Operanden move.l a2 , a0 ;Zeiger auf Zeiger auf Operanden srchloop: tst.b dinvers (a3) ;nicht inversen Knoten gefunden? beq.s ok_gef ;ja lea drechts (a3) , a0 ;Zeiger auf Zeiger auf nächsten Op move.l (a0) , a3 ;Zeiger auf nächsten Operanden bra.s srchloop ok_gef: move.l drechts (a3) , (a0) ;gefundenen Operanden ausketten move.l (a2) , drechts (a3) ;und an erster Stelle der ;Operandenliste einketten move.l a2 , a1 ;Operandenheader moveq #knotenlange , d0 ;löschen jsr freemem (a6) move.l a3 , a2 ;erster Operand wird neuer Vater move.l drechts (a3) , a3 ;Zeiger auf nächsten Operanden clr.l drechts (a2) ;neuen Vater ausketten pea (a3) ;Zeiger auf nächsten Operanden retten bsr.s winbin move.l (sp)+ , a3 ;Zeiger auf nächsten Operanden winloop: move.l a3 , d0 ;keine weiteren Operanden? beq.s ewinbin ;nein moveq #knotenlange , d0 ;neuen move.l #MEMF_CLEAR , d1 ;Vaterknoten jsr allocmem (a6) ;anfordern move.l d0 , a0 ;zur Initialisierung move.l a2 , (a0) ;bisheriger Vater wird linker Sohn tst.b dinvers (a3) ;muß Vaterverknüpfung invers sein? beq.s nrmlvknt ;nein move.b (sp) , dop (a0) ;inverse Verknüpfung im Vater bra.s vknset nrmlvknt: move.b 2(sp) , dop (a0) ;normale Verknüpfung im Vater vknset: clr.b dinvers (a3) ;Binärbaum kennt Inversflagge nicht pea (a0) ;Zeiger auf neuen Vater retten move.l a3 , a2 ;Operand fertig zum wandeln machen move.l drechts (a3) , a3 ;nächster Operand clr.l drechts (a2) ;ausketten pea (a3) ;Zeiger auf nächsten Operanden retten bsr.s winbin move.l (sp)+ , a3 ;Zeiger auf nächsten Operanden move.l (sp)+ , a0 ;neuer Vaterknoten move.l a2 , drechts (a0) ;rechten Sohn anhängen move.l a0 , a2 ;neuen Vater setzen bra.s winloop ewinbin: addq.l #4 , sp ;lokale Variable freigeben ewinbin2: rts no_opknt: pea (a2) ;Vater retten wegen postfix Rekursion move.l (a2) , a2 ;Zeiger auf linken Sohn stellen bsr.s winbin move.l (sp) , a0 ;Zeiger auf Vaterknoten rückgewinnen move.l a2 , (a0)+ ;linken Sohn einhängen move.l (a0) , a2 ;rechten Sohn auswählen bsr.s winbin ;rechten Sohn wandeln move.l (sp)+ , a0 ;ursprünglichen Vater rückholen move.l a2 , drechts (a0) ;rechten Sohn einhängen move.l a0 , a2 ;Zeiger auf Vater rts ;*** Port, von dem sich der server die Kommandos holt port: mp_succ: dc.l 0 mp_pred: dc.l 0 mp_type: dc.b 4 mp_pri: dc.b 0 mp_name: dc.l 0 mp_flags: dc.b 0 mp_sigbit: dc.b 0 mp_sigtask: dc.l 0 mp_lh_head: dc.l mp_lh_tail mp_lh_tail: dc.l 0 mp_lh_tailpred: dc.l mp_lh_head mp_lh_type: dc.b 5 mp_lh_pad: dc.b 0 ;*** Weitere Datenbereiche mathbase: dc.l 0 handler: dc.l fwerthandler xarray: dc.l 0 mathffpname: dc.b "mathffp.library" , 0 mathtransname: dc.b "mathtrans.library" , 0