Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 21090 lines (20504 sloc) 868 KB
sprache EQU 0 ;0=Deutsch, 1=Englisch
version EQU $01071400 ;Die Versionsnummer (Macroversion >= $200000)
etv_exit EQU $040C ;etv_exit()-Vektor
xbra_id EQU 'BUG1'
OPT X-,F-,O+,W+
********************************************************************************
* TurboAss Bugaboo *
* von Markus Fritze *
********************************************************************************
>PART 'Header'
OUTPUT 'BUGABOO.PRG'
IF ^^SYMTAB
DEFAULT 1
ELSE
DEFAULT 2
ENDC
TEXT
anfang: jsr init_all
DATA
DC.L ^^RANDOM ;ohne Funktion
DC.L ^^RANDOM ;ohne Funktion
DC.L $110000 ;Interne Versionsnummer der Debuggers
DC.L ^^RANDOM
DXSET 31,0
DX.B 'Shareware-Basisversion'
DX.B 'Markus Fritze, Birkhahnkamp 38'
DX.B '2000 Norderstedt 1'
EVEN
ENDPART
>PART 'start'
start: move.l SP,old_usp(A4) ;USP merken
pea @_trap3(A4)
move.l #$050023,-(SP)
trap #13 ;Trap #3 setzen (Supervisor-Mode an)
addq.l #8,SP
move.l D0,old_trap3
movea.l D0,A0 ;Alten Trap #3-Vektor holen
cmpi.l #'TASS',-8(A0) ;Start durch den Assembler?
seq D0 ;dann D0=-1
trap #3 ;Supervisormode an
move.l SP,old_stack(A4) ;und den Stackpointer merken
move.b D0,ass_load(A4) ;Flag für Laden durch den Assembler
bne.s start1 ;dann automatisch resident werden
st le_allowed(A4) ;LE ist erlaubt
move.l #$0A000100,D0 ;appl_init()
bsr aes
move.l #$13000100,D0 ;appl_exit()
bsr aes
move.w spaced2+32(A4),D2 ;AES-Versionsnummer merken
sne D2 ;D2 = $FF, wenn die AES vorhanden ist
move.b do_resident(A4),D1 ;resident-Flag
movea.l kbshift_adr(A4),A0
moveq #4,D0
and.b (A0),D0 ;Control gedrückt?
sne D0 ;D0=$FF, wenn gedrückt
eor.b D0,D1 ;B = A xor B
or.b D2,D0 ;A = A or C
not.b D0 ;A = not A
and.b D2,D1 ;B = B and C
or.b D1,D0 ;A = not(A or C)or(C and (A xor B))
move.b D0,do_resident(A4)
beq.s start2 ;nicht resident
pea resident_text(PC)
move.w #9,-(SP)
trap #1 ;Message für Resident ausgeben
addq.l #6,SP
start1: st do_resident(A4) ;automatisch resident werden
start2: jsr @init(A4) ;alles mögliche initialisieren
bra.s start4
resident_text: DC.B 13,10,'Bugaboo V'
DC.B (version>>24)&$0F+'0'
DC.B '.'
IF (version>>20)&$0F<>0
DC.B (version>>20)&$0F+'0'
ENDC
DC.B (version>>16)&$0F+'0'
DC.B '.'
IF (version>>12)&$0F<>0
DC.B (version>>12)&$0F+'0'
ENDC
DC.B (version>>8)&$0F+'0'
IF version&$FF
DC.B version&$FF
ENDC
DC.B ' resident',13,10,0
EVEN
;allgemeiner Debuggereinsprung
newstart: lea varbase,A4
move.l A0,first_free(A4) ;1.freie Adresse im RAM
move.l A1,quit_stk(A4) ;Rücksprungadr
move.l A1,D0
beq.s newstart1 ;keine Rücksprungadresse
cmpi.l #$DEADFACE,-(A1) ;Magic?
bne.s newstart1 ;Nein!
move.l -(A1),cmd_line_adr(A4) ;Adresse der Commandline
move.l A1,ass_vector(A4) ;Zeiger auf Sprungtabelle merken
newstart1: st le_allowed(A4) ;LE ist erlaubt
clr.b help_allow(A4)
move.l A2,prg_base(A4) ;Adr des akt.Prgs
beq.s newstart2 ;auto-load => LE verboten
sf le_allowed(A4) ;LE ist nicht erlaubt
move.b (A2),help_allow(A4)
newstart2: clr.l merk_svar(A4)
tst.b help_allow(A4) ;CTRL-HELP erlaubt?
bpl.s newstart3 ;Nein! =>
move.l A3,D0
subq.l #8,D0
bmi.s newstart3 ;auch im RAM?
move.l A3,merk_svar(A4)
newstart3: clr.l end_of_mem(A4)
trap #3
movea.l default_stk(A4),SP ;ist ja bereits initialisiert
moveq #-1,D0
move.l D0,line_back(A4)
jsr @init(A4)
start4: clr.l etv_exit.w ;etv_exit()-Vektor löschen
movea.l act_pd(A4),A0
movea.l (A0),A0 ;Zeiger auf die Basepage des akt.Prgs
move.l A0,merk_act_pd(A4) ;aktuelles Programm merken
lea 128(A0),A0
move.b (A0),D0 ;existiert noch eine Commandline?
beq.s start5 ;Nein =>
clr.b (A0)+ ;Commandline verwerfen
bsr do_cmdline ;Commandline in den Eingabe-Buffer
start5:
sf auto_sym(A4) ;Symboltabelle durch den Assembler?
st autodo_flag(A4) ;CTRL+M-Befehl ausführen
lea gemdos_break(A4),A0
lea end_of_breaks(A4),A1
start6: tst.b (A0) ;Abbruch beim Trap?
sne (A0)+ ;dann Flag setzen
cmpa.l A1,A0
blo.s start6
suba.l A1,A1
movea.l $2C.w,A0 ;Linef-Vektor holen
move.l A0,D7
btst #0,D7 ;Englisches Vobis-TOS (85)
bne.s start8 ;=> raus
lea 20(A0),A0
cmpi.w #$207C,(A0)+ ;MOVE.L #,A0 ?
bne.s start8
movea.l (A0),A1 ;Basisadr der Tabelle holen
move.l A1,linef_base(A4)
subq.l #4,A1
moveq #-4,D7
start7: addq.l #4,A1
addq.w #4,D7
tst.b (A1)
beq.s start7
move.w D7,max_linef(A4) ;maximal erlaubter Line-F-Opcode
start8:
movea.l #sekbuff,A0 ;internen SSP setzen
adda.l A4,A0
movea.l A0,SP
move.l A0,default_stk(A4) ;und merken
bsr initreg ;Register initialisieren
jsr set_reg ;Traceback-Buffer initialisieren
tst.b ass_load(A4) ;Laden durch den Assembler?
bne cmd_resident2 ;automatisch resident
jsr @set_ins_flag(A4) ;Insert/Overwrite anzeigen
jsr @redraw_all(A4) ;Bildschirm neu aufbauen
f_direct: move.l first_free(A4),default_adr(A4) ;1.freie Adresse im RAM
st testwrd(A4) ;Ausgabe nach A0 umlenken
moveq #'1',D0
add.b prozessor(A4),D0 ;Prozessor einsetzen
move.b D0,__star2
sf testwrd(A4) ;Ausgabe wieder auf den Schirm
jsr @c_clrhome(A4) ;Bildschirm löschen
pea __star(PC) ;Text der Startmeldung
jsr @print_line(A4) ;ausgeben
tst.b install_load(A4)
beq.s initvi2
pea __star4(PC)
jsr @print_line(A4) ;Installation wurde geladen
initvi2: sf install_load(A4)
jsr @c_eol(A4) ;Zeile löschen
jsr @crout(A4) ;CR ausgeben
jsr @c_eol(A4) ;Zeile löschen
move.l trace_pos(A4),reg_pos(A4)
all_normal: lea main_loop(PC),A0
move.l A0,jmpdispa(A4) ;Sprungdispatcher auf Hauptschleife
jmp (A4)
SWITCH sprache
CASE 0
__star: DC.B " ∑-Soft's Bugaboo V"
DC.B (version>>24)&$0F+'0'
DC.B '.'
IF (version>>20)&$0F<>0
DC.B (version>>20)&$0F+'0'
ENDC
DC.B (version>>16)&$0F+'0'
DC.B '.'
IF (version>>12)&$0F<>0
DC.B (version>>12)&$0F+'0'
ENDC
DC.B (version>>8)&$0F+'0'
IF version&$FF
DC.B version&$FF
ENDC
DC.B ' von Markus Fritze und Sören Hellwig',13
DC.B ' Ein 680'
__star2: DC.B '00 Prozessor ist aktiv.',13,0
__star4: DC.B ' Parameter wurden geladen.',13,0
CASE 1
__star: DC.B ' Bugaboo V'
DC.B (version>>24)&$0F+'0'
DC.B '.'
IF (version>>20)&$0F<>0
DC.B (version>>20)&$0F+'0'
ENDC
DC.B (version>>16)&$0F+'0'
DC.B '.'
IF (version>>12)&$0F<>0
DC.B (version>>12)&$0F+'0'
ENDC
DC.B (version>>8)&$0F+'0'
IF version&$FF
DC.B version&$FF
ENDC
DC.B ' by ∑-Soft',13
DC.B ' The Bozos: Markus Fritze and Sören Hellwig',13
DC.B ' 680'
__star2: DC.B '00 Processor is active',13,0
__star4: DC.B ' parameter-file loaded',13,0
ENDS
EVEN
ENDPART
********************************************************************************
* Sprungverteiler der Funktionen *
********************************************************************************
>PART 'inp_loop'
ret_jump: lea varbase,A4
movea.l default_stk(A4),SP ;Stackpointer zurückholen
jsr @my_driver(A4) ;eigene Treiber rein (für CLR 8,4FF)
jsr set_reg
moveq #14,D0
jsr disable_irq ;Ring-Indicator aus
move.b #'$',hexbase
clr.l trace_count(A4) ;Tracecount löschen
moveq #0,D0
jsr graf_mouse ;Pfeil einschalten
andi.b #$10,kbshift(A4)
clr.b direct(A4)
lea screen+1920(A4),A0
jsr @get_line(A4) ;letzte Zeile auswerten
tst.b D0 ;steht was in der letzten Zeile?
beq.s ret_jump1 ;Nein!=>
tst.b ignore_autocrlf(A4) ;CR/LF unterdrücken?
bne.s ret_jump1 ;Ja! =>
jsr @crout(A4) ;CR/LF
jsr @c_eol(A4)
ret_jump1: andi #$FB00,SR ;IRQs freigeben
move.l jmpdispa(A4),-(SP)
rts
ENDPART
********************************************************************************
* Die Hauptschleife *
********************************************************************************
>PART 'main_loop'
main_loop: jsr @page1(A4) ;Debuggerscreen an
sf untrace_flag(A4) ;Kein Untrace mehr an
clr.l untrace_count(A4) ;Untracecounter löschen
clr.b device(A4) ;Keine Druckerausgabe
sf testwrd(A4) ;Ausgabe auf den Schirm (nicht nach A0)
clr.l breakpnt+12*16(A4) ;Break#16 löschen
move.l default_adr(A4),D1
jsr @anf_adr(A4)
tst.b assm_flag(A4) ;Eingabe durch den Line-Assembler?
beq.s main_loop2 ;Nein!
lea _zeile2(A4),A0 ;UNDO-Buffer
jsr @get_line(A4) ;Zeile auswerten
cmp.b #'|',D0
beq.s main_loop1 ;Do-Befehl?
cmp.b #'!',D0
bne.s main_loop2 ;Line-Assembler?
main_loop1: jsr @chrout(A4) ;automatisch wieder ausgeben
sf assm_flag(A4) ;Eingabe mit dem Line-Assembler beenden
main_loop2: tst.b illegal_flg(A4) ;CTRL+Cursor left für Illegal
beq.s main_loop3
sf illegal_flg(A4)
jsr @cache_up(A4) ;und einen Eintrag im Cache zurück
jsr @cursor_off(A4) ;Cursor ja wieder ausschalten
main_loop3: move.l $04BA.w,D0
move.l hz200_time(A4),D1
cmp.l D1,D0
bhs.s main_loop4 ;Timer-Unterlauf verhindern (Harddisk!)
move.l D1,D0
move.l D0,$04BA.w
main_loop4: move.l D0,hz200_time(A4)
bsr rgout ;Register ausgeben
jsr @desel_menü(A4) ;evtl. selektierten Menüeintrag deselektieren
tst.l prg_base(A4) ;Prg automatisch laden
bne autoload
tst.b do_resident(A4) ;'RESIDENT' automatisch ausführen?
bne cmd_resident2 ;=> AUTO-Ordner-Version
clr.b akt_maust(A4)
clr.b maus_merk(A4) ;Maustasten sind nicht gedrückt!
clr.b maus_merk2(A4)
move.w #-1,maus_flag(A4) ;Flag wieder zurücksetzen
st mausprell(A4)
st mausprell2(A4)
clr.b maustast(A4)
main_loop5: st first_call(A4)
tst.b autodo_flag(A4)
bne autodo ;CTRL+M-Befehl automatisch ausführen
bclr #0,help_allow(A4) ;Bit 0: Direktstart
beq.s main_loop6 ;Nein =>
jmp cmd_go ;Direktstart =>
main_loop6: tst.b fast_exit(A4)
beq.s main_loop7 ;<>0 => sofort mit CTRL+HELP raus
jmp do_help
main_loop7: move.l input_pnt(A4),D0 ;BREAKPT-Directive?
beq.s call_scr_edit ;Nein! => Screen-Editor
movea.l D0,A0
moveq #':',D1 ;der Zeilentrenner
main_loop71: move.b (A0)+,D0 ;noch was im Buffer?
beq.s call_scr_edit ;Nein! => Screen-Editor
cmp.b #' ',D0 ;Führungsspaces ignorieren
beq.s main_loop71
cmp.b D1,D0 ;Zeilentrenner am Anfang?
beq.s main_loop71 ;ja! => ignorieren
lea _zeile(A4),A1
moveq #0,D2 ;Flag für Anführungszeichen
bra.s main_loop83
main_loop8: move.b (A0)+,D0
beq.s main_loop9 ;Stringende =>
main_loop83: cmp.b #'"',D0 ;Anführungszeichen?
bne.s main_loop81 ;Nein! =>
not.b D2 ;Flag dafür toggeln
main_loop81: tst.b D2 ;innerhalb von Anführungszeichen?
bne.s main_loop82 ;Ja! => nicht auf ':' testen
cmp.b D1,D0 ;Zeilentrenner?
bne.s main_loop82 ;Ja! =>
cmp.b (A0),D1 ;noch einen Zeilentrenner?
bne.s main_loop10 ;Nein => Ende der Eingabe
bra.s main_loop8
main_loop82: move.b D0,(A1)+ ;in den Eingabebuffer kopieren
bra.s main_loop8
main_loop9: suba.l A0,A0 ;Flag dafür löschen
main_loop10: clr.b (A1) ;Eingabebuffer abschließen
move.l A0,input_pnt(A4)
cmpi.b #'-',(A0) ;folgt noch ein "-"?
bne.s main_loop11 ;Nee =>
addq.l #1,input_pnt(A4)
bra.s main_loop13 ;dann nix ausgeben!
main_loop11: pea _zeile(A4)
jsr @print_line(A4)
jsr @crout(A4) ;Befehl ausgeben
bra.s main_loop13 ;und auswerten
call_scr_edit: clr.l input_pnt(A4) ;Batch-Pointer zurücksetzen
sf batch_flag(A4) ;Batch-Mode aus
jsr @scr_edit(A4) ;Auf Eingabe warten
main_loop13: lea _zeile(A4),A0
inp_loop1: bsr get
tst.b D0
beq ret_jump ;Leereingabe
cmp.b #'0',D0
blo.s inp_loop2 ;nix
cmp.b #'9',D0 ;Zeichen eine Zahl?
bls.s inp_loop3 ;ja
inp_loop2: bsr numbas ;Zahlenbasis auswerten
bmi.s inp_loop4 ;nein, keine Zahl!
bsr get
inp_loop3: bsr get_zahl ;Zahl einlesen
move.l D1,default_adr(A4) ;neue Defaultadresse
inp_loop4: cmp.b #'>',D0
beq.s inp_loop5
cmp.b #'Ø',D0 ;Prompt ignorieren!
beq.s inp_loop5
cmp.b #'',D0
bne.s inp_loop6
inp_loop5: bsr get ;PC-Markierung überlesen
inp_loop6: tst.b D0
beq ret_jump
subq.l #1,A0
movea.l A0,A6
movea.l A0,A5
lea cmdtab(PC),A1
lea cmdadr-2(PC),A2
inp_loop7: addq.l #2,A2
movea.l A6,A0
inp_loop8: move.b (A0),D0
cmp.b #' ',D0 ;Space
beq.s inp_loop11
cmpa.l A0,A5 ;1.Zeichen?
beq.s inp_loop9 ;Ja! =>
cmp.b #'A',D0 ;Punkt erst ab der 2.Stelle testen
blo.s inp_loop11
cmp.b #'Z',D0
bls.s inp_loop9
cmp.b #'a',D0 ;Sonderzeichen: z.B. M^A0
blo.s inp_loop11
cmp.b #'z',D0
bhi.s inp_loop11
inp_loop9: tst.b D0 ;Zeilenende
beq.s inp_loop11
tst.b (A1) ;Befehlsende
beq.s inp_loop11
bmi no_bef
bsr get
cmp.b (A1)+,D0
beq.s inp_loop8
inp_loop10: tst.b (A1)+
bne.s inp_loop10
bra.s inp_loop7
inp_loop11: moveq #0,D1
move.w (A2),D1 ;unsigned word
adda.l D1,A2 ;Adresse der Routine ermitteln
IFEQ ^^SYMTAB
lea intern_bus,A6
move.l A6,8.w ;Interne Busfehler abfangen
ENDC
clr.b direct(A4)
jmp (A2)
ENDPART
>PART 'cmdtab'
cmdtab: DC.B ' ',0 ;Dummy, wird überlesen
DC.B '&',0
DC.B '#',0
DC.B '@',0
DC.B '!',0
DC.B '|',0
DC.B '?',0
DC.B '/',0
DC.B ')',0
DC.B ']',0
DC.B '.',0
DC.B ',',0
DC.B $22,0
DC.B 'PRN',0
DC.B 'P',0
DC.B 'BREAKPOINTS',0
DC.B 'SAVE',0
DC.B 'SYMBOLTABLE',0
DC.B 'SYSINFO',0
DC.B 'SYSTEM',0
DC.B 'SET',0
DC.B 'MEMORY',0
DC.B 'LIST',0
DC.B 'LL',0
DC.B 'DISASSEMBLE',0
DC.B 'DUMP',0
DC.B 'LEXECUTE',0
DC.B 'LOAD',0
DC.B 'GO',0
DC.B 'UNTRACE',0
DC.B 'INFO',0
DC.B 'TRACE',0
DC.B 'CALL',0
DC.B 'IF',0
DC.B 'MOVE',0
DC.B 'COMPARE',0
DC.B 'COPY',0
DC.B 'DIRECTORY',0
DC.B 'HUNT',0
DC.B 'FIND',0
DC.B 'FILL',0
DC.B 'CLS',0
DC.B 'ASCII',0
DC.B 'ASCFIND',0
DC.B 'LET',0
DC.B 'EXIT',0
DC.B 'QUIT',0
DC.B 'TYPE',0
DC.B 'SHOWMEMORY',0
DC.B 'MOUSEON',0
DC.B 'MON',0
DC.B 'SHOWMOUSE',0
DC.B 'MOUSEOFF',0
DC.B 'MOFF',0
DC.B 'HIDEMOUSE',0
DC.B 'READSEKTOR',0
DC.B 'RSEKTOR',0
DC.B 'WRITESEKTOR',0
DC.B 'WSEKTOR',0
DC.B 'READSECTOR',0
DC.B 'RSECTOR',0
DC.B 'WRITESECTOR',0
DC.B 'WSECTOR',0
DC.B 'READTRACK',0
DC.B 'RTRACK',0
DC.B 'ERASE',0
DC.B 'KILL',0
DC.B 'FREE',0
DC.B 'MKDIRECTORY',0
DC.B 'RMDIRECTORY',0
DC.B 'NAME',0
DC.B 'FORMAT',0
DC.B 'GETREGISTER',0
DC.B 'LINE',0
DC.B 'CR',0
DC.B 'FOPEN',0
DC.B 'FCLOSE',0
DC.B 'CLR',0
DC.B 'CACHECLR',0
DC.B 'CACHEGET',0
DC.B 'RESET',0
DC.B 'CHECKSUMME',0
DC.B 'FILE',0
DC.B 'SWITCH',0
DC.B 'RESIDENT',0
DC.B 'CURSOR',0
DC.B 'INITREGISTER',0
DC.B 'BSSCLEAR',0
DC.B 'OBSERVE',0
DC.B 'DO',0
DC.B 'SYNC',0
DC.B 'RWABS',0
DC.B 'CONTINUE',0
DC.B 'FATTRIBUT',0
DC.B 'LABELBASE',0
DC.B 'HELP',0
DC.B 'READFDC',0
DC.B 'COOKIE',0
DC.B 'OVERSCAN',0
DC.B 'B',0
DC.B 'F',0
DC.B '~',0
DC.B -1
EVEN
OPT W-
BASE DC.W,*
cmdadr: DC.W ret_jump
DC.W cmd_und ;&
DC.W cmd_number ;#
DC.W cmd_atsign ;@
DC.W cmd_assem ;!
DC.W cmd_dobef ;|
DC.W cmd_calc ;?
DC.W cmd_dchng ;/
DC.W cmd_achng ;)
DC.W cmd_schng ;]
DC.W cmd_chng ;.
DC.W cmd_mchng ;,
DC.W cmd_send ;"
DC.W cmd_prnt ;PRN
DC.W cmd_prnt ;P
DC.W cmd_bkpt ;BREAKPOINTS
DC.W cmd_save ;SAVE
DC.W cmd_symbol ;SYMBOLTABLE
DC.W cmd_sysinfo ;SYSINFO
DC.W cmd_exit ;SYSTEM
DC.W cmd_set ;SET
DC.W cmd_dump ;MEMORY
DC.W cmd_list ;LIST
DC.W cmd_listf ;LIST+
DC.W cmd_disass ;DISASSEMBLE
DC.W cmd_dump ;DUMP
DC.W cmd_lexec ;LEXEC
DC.W cmd_load ;LOAD
DC.W cmd_go ;GO
DC.W cmd_untrace ;UNTRACE
DC.W cmd_info ;INFO
DC.W cmd_trace ;TRACE
DC.W cmd_call ;CALL
DC.W cmd_if ;IF
DC.W cmd_move ;MOVE
DC.W cmd_compare ;COMPARE
DC.W cmd_move ;COPY
DC.W cmd_dir ;DIRECTORY
DC.W cmd_hunt ;HUNT
DC.W cmd_find ;FIND
DC.W cmd_fill ;FILL
DC.W cmd_cls ;CLS
DC.W cmd_asc ;ASCII
DC.W cmd_findasc ;ASCFIND
DC.W cmd_set ;LET
DC.W cmd_exit ;EXIT
DC.W cmd_exit ;QUIT
DC.W cmd_type ;TYPE
DC.W cmd_showmem ;SHOWMEMORY
DC.W cmd_mon ;MOUSEON
DC.W cmd_mon ;MON
DC.W cmd_mon ;SHOWM
DC.W cmd_moff ;MOUSEOFF
DC.W cmd_moff ;MOFF
DC.W cmd_moff ;HIDEM
DC.W cmd_dread ;READSEKTOR
DC.W cmd_dread ;RSEKTOR
DC.W cmd_dwrite ;WRITESEKTOR
DC.W cmd_dwrite ;WSEKTOR
DC.W cmd_dread ;READSECTOR
DC.W cmd_dread ;RSECTOR
DC.W cmd_dwrite ;WRITESECTOR
DC.W cmd_dwrite ;WSECTOR
DC.W cmd_rtrack ;READTRACK
DC.W cmd_rtrack ;RTRACK
DC.W cmd_erase ;KILL
DC.W cmd_erase ;ERASE
DC.W cmd_free ;FREE
DC.W cmd_mkdir ;MKDIR
DC.W cmd_rmdir ;RMDIR
DC.W cmd_name ;NAME
DC.W cmd_format ;FORMAT
DC.W cmd_getreg ;GETREGISTER
DC.W cmd_line ;LINE
DC.W cmd_crout ;CR
DC.W cmd_fopen ;FOPEN
DC.W cmd_fclose ;FCLOSE
DC.W cmd_clr ;CLR
DC.W cmd_clrcach ;CACHECLR
DC.W cmd_getcach ;CACHEGET
DC.W cmd_reset ;RESET
DC.W cmd_checksum ;CHECKSUMME
DC.W cmd_file ;FILE
DC.W cmd_switch ;SWITCH
DC.W cmd_resident ;RESIDENT
DC.W cmd_swchcur ;CURSOR
DC.W cmd_ireg ;INITREGISTER
DC.W cmd_bclr ;BSSCLEAR
DC.W cmd_obser ;OBSERVE
DC.W cmd_do ;DO
DC.W cmd_sync ;SYNC
DC.W cmd_rwabs ;RWABS
DC.W cmd_cont ;CONTINUE
DC.W cmd_fattrib ;FATTRIBUT
DC.W cmd_labelbase ;LABELBASE
DC.W cmd_help ;HELP
DC.W cmd_fdc ;READFDC
DC.W cmd_cookie ;COOKIE
DC.W cmd_overscan ;OVERSCAN
DC.W cmd_bkpt ;B
DC.W cmd_file ;F
DC.W cmd_set ; ~
ENDPART
********************************************************************************
* Sprungleiste der Menüfunktionen *
********************************************************************************
>PART 'f_jumps'
BASE DC.W,f_jumps
f_jumps: DC.W f_trace ;F1 - Trace (Fast Traps)
DC.W f_do_pc ;F2 - Do PC
DC.W f_trarts ;F3 - Trace until RTS
DC.W f_traall ;F4 - Trace all
DC.W f_skip ;F5 - Skip
DC.W f_dir ;F6 - Directory
DC.W f_hexdump ;F7 - Hexdump
DC.W f_disass ;F8 - Disassemble
DC.W f_list ;F9 - List
DC.W f_switch ;F10 - Switch Screen
DC.W f_68020emu ;S+F1 - 68020 Emulator (für Trace)
DC.W f_trasub ;S+F2 - Don't trace Subroutine
DC.W f_trarte ;S+F3 - Trace until RTE/RTR
DC.W go_pc ;S+F4 - Go
DC.W f_togmode ;S+F9 - Overwrt/Insert
DC.W f_marker ;S+F6 - Marker
DC.W f_break ;S+F7 - Breakpoints anzeigen
DC.W f_info ;S+F8 - Info
DC.W f_direct ;S+F5 - Direct
DC.W f_quit ;S+F10 - Quit
OPT W+
ENDPART
********************************************************************************
* S+F6 - Marker anzeigen *
********************************************************************************
>PART 'f_marker'
f_marker: movea.l #allg_buffer,A0
adda.l A4,A0
lea mark_va(PC),A1
moveq #'1',D1
moveq #9,D0
f_marker1: move.l A0,(A1)+ ;RSC-Texte im Buffer aufbauen
addq.l #6,A1
move.b #'M',(A0)+
move.b D1,(A0)+
move.b #':',(A0)+
move.b #'$',(A0)+
moveq #15,D2
f_marker3: move.b #' ',(A0)+
dbra D2,f_marker3
clr.b (A0)+
addq.w #1,D1
cmp.w #':',D1
bne.s f_marker2
moveq #'0',D1
f_marker2: dbra D0,f_marker1
st testwrd(A4)
movea.l basep(A4),A0 ;Adresse des Basepage
move.l 8(A0),D2 ;Anfangsadr des TEXT-Segments
move.l $18(A0),D3 ;Anfangsadr des BSS-Segments
add.l $1C(A0),D3 ;+ Länge des BSS-Segments
lea simple_vars(A4),A5
lea mark_va(PC),A2
lea mark_vb(PC),A3
moveq #9,D7
f_mark1: movea.l (A2)+,A0 ;Adresse des Strings holen
addq.l #4,A0
move.l (A5)+,D1
bsr hexlout ;Variablenwert einsetzen
addq.l #1,A0
moveq #4,D0
f_mark2: move.b #'?',(A0)+ ;Zeilennummer unbekannt
dbra D0,f_mark2
lea marker_25(PC),A6 ;Default-Symbol = " "
cmp.l D2,D1
blo.s f_mark3 ;<TEXT-Segment
cmp.l D3,D1
bhs.s f_mark3 ;>BSS-Segment
tst.l sym_size(A4) ;Symboltabelle überhaupt da?
beq.s f_mark3 ;keine Symbole da!
andi.w #$FFEF,4(A3) ;Light aus!
bsr hunt_symbol
bne.s f_mark8
ori.w #$10,4(A3) ;Light an
f_mark8: movea.l (A1),A6 ;Symbolnamesadresse holen
f_mark3: move.l A6,(A3)+ ;Adresse einsetzen
addq.l #6,A3
addq.l #6,A2
dbra D7,f_mark1
move.l merk_svar(A4),D0
beq.s f_mark6 ;Keine Übergabe durch den Assembler
movea.l D0,A1
moveq #9,D7
lea mark_va(PC),A2
f_mark4: movea.l (A2)+,A0 ;Adresse des Strings holen
lea 12(A0),A0 ;Zeiger auf die Zeilennummer
moveq #0,D1
move.w (A1)+,D1
addq.w #1,D1
beq.s f_mark5 ;Zeilennummer -1 ist illegal
subq.w #1,D1
moveq #5,D4
bsr dezw_out ;Zeilennummer einsetzen
f_mark5: addq.l #6,A2
addq.l #4,A1
dbra D7,f_mark4
f_mark6: sf testwrd(A4)
lea marker_rsc(PC),A0
jsr @form_do(A4)
subq.w #2,D0
bmi.s f_mark7
lsl.l #2,D0
lea simple_vars(A4),A0
move.l 0(A0,D0.w),D1 ;Variablenwert holen
jsr do_dopp ;"Doppelklick" ausführen
f_mark7: rts
marker_rsc: DC.W 0,0,49,15,1
DC.W 5,4
mark_va: DC.L 0
DC.W 8
DC.W 5,5
DC.L 0
DC.W 8
DC.W 5,6
DC.L 0
DC.W 8
DC.W 5,7
DC.L 0
DC.W 8
DC.W 5,8
DC.L 0
DC.W 8
DC.W 5,9
DC.L 0
DC.W 8
DC.W 5,10
DC.L 0
DC.W 8
DC.W 5,11
DC.L 0
DC.W 8
DC.W 5,12
DC.L 0
DC.W 8
DC.W 5,13
DC.L 0
DC.W 8
DC.W 25,4
mark_vb: DC.L 0 ;Labeladressen einsetzen
DC.W 8
DC.W 25,5
DC.L 0 ;wenn keins definiert, "marker_25" einsetzen
DC.W 8
DC.W 25,6
DC.L 0
DC.W 8
DC.W 25,7
DC.L 0
DC.W 8
DC.W 25,8
DC.L 0
DC.W 8
DC.W 25,9
DC.L 0
DC.W 8
DC.W 25,10
DC.L 0
DC.W 8
DC.W 25,11
DC.L 0
DC.W 8
DC.W 25,12
DC.L 0
DC.W 8
DC.W 25,13
DC.L 0
DC.W 8
DC.W 40,1
DC.L marker_13
DC.W $26
DC.W 1,4
DC.L marker_25 ;Die Buttons
DC.W $24
DC.W 3,5
DC.L marker_25
DC.W $24
DC.W 1,6
DC.L marker_25
DC.W $24
DC.W 3,7
DC.L marker_25
DC.W $24
DC.W 1,8
DC.L marker_25
DC.W $24
DC.W 3,9
DC.L marker_25
DC.W $24
DC.W 1,10
DC.L marker_25
DC.W $24
DC.W 3,11
DC.L marker_25
DC.W $24
DC.W 1,12
DC.L marker_25
DC.W $24
DC.W 3,13
DC.L marker_25
DC.W $24
DC.W 9,3
DC.L marker_10
DC.W 8
DC.W 18,3
DC.L marker_11
DC.W 8
DC.W 32,3
DC.L marker_12
DC.W 8
DC.W 15,1
DC.L marker_24
DC.W 8
DC.W -1
marker_25: DC.B ' ',0
SWITCH sprache
CASE 0
marker_10: DC.B 'Adresse:',0
marker_11: DC.B 'Zeile:',0
marker_12: DC.B 'Labelname:',0
marker_24: DC.B 'Markerliste:',0
marker_13: DC.B ' OK ',0
CASE 1
marker_10: DC.B ' adr:',0
marker_11: DC.B 'line:',0
marker_12: DC.B 'labelname:',0
marker_24: DC.B 'Marker',0
marker_13: DC.B ' OK ',0
ENDS
EVEN
ENDPART
********************************************************************************
* S+F7 - Breakpoints anzeigen *
********************************************************************************
>PART 'f_break'
f_break: lea breakpnt(A4),A2
lea cond_breaks(A4),A3
lea break_rsc_base(PC),A5
movea.l #allg_buffer,A0
adda.l A4,A0
st testwrd(A4)
moveq #15,D7
f_brea1: move.l A0,(A5)+ ;Adresse einsetzen
addq.l #6,A5
lea 42(A0),A1
move.b #'B',(A0)+
move.b #'0',(A0)+
move.w D7,D0
neg.w D0
add.w #15+'0',D0
cmp.b #'9',D0
bls.s f_brea10
addq.w #7,D0
f_brea10: move.b D0,(A0)+
move.b #'=',(A0)+
move.b #'$',(A0)+
move.l (A2)+,D1 ;Breakpointadr
bne.s f_brea2
moveq #7,D0
f_brea4: move.b #'0',(A0)+ ;Breakpoint nicht gesetzt
dbra D0,f_brea4
addq.l #8,A2
bra.s f_brea3
f_brea2: bsr hexlout
move.w (A2)+,D1 ;Breakpointtyp
move.l (A2),D2 ;Zähler, ...
addq.l #6,A2 ;zeigt nun auf den nächsten Breakpoint
subq.w #1,D1
beq.s f_brea5
bcs.s f_brea6
bmi.s f_brea7
move.b #',',(A0)+
move.b #'?',(A0)+
move.l A3,-(SP)
moveq #27,D0 ;max. 28 Zeichen ausgeben
f_brea9: move.b (A3)+,(A0)+
dbeq D0,f_brea9
movea.l (SP)+,A3
bra.s f_brea3
f_brea7: tst.l D2
bls.s f_brea3
move.b #',',(A0)+
bra.s f_brea8
f_brea6: move.b #',',(A0)+
move.b #'=',(A0)+
f_brea8: move.l D2,D1
bsr dezout ;Dezimalzahl ausgeben
bra.s f_brea3
f_brea5: move.b #',',(A0)+
move.b #'*',(A0)+
f_brea3: clr.b (A0)
lea 80(A3),A3
movea.l A1,A0
dbra D7,f_brea1
sf testwrd(A4)
lea break_rsc(PC),A0
jmp @form_do(A4)
break_rsc: DC.W 0,0,44,20,1
DC.W 18,18
DC.L ok_button
DC.W $26
DC.W 1,1
break_rsc_base: DC.L 0
DC.W 8
DC.W 1,2
DC.L 0
DC.W 8
DC.W 1,3
DC.L 0
DC.W 8
DC.W 1,4
DC.L 0
DC.W 8
DC.W 1,5
DC.L 0
DC.W 8
DC.W 1,6
DC.L 0
DC.W 8
DC.W 1,7
DC.L 0
DC.W 8
DC.W 1,8
DC.L 0
DC.W 8
DC.W 1,9
DC.L 0
DC.W 8
DC.W 1,10
DC.L 0
DC.W 8
DC.W 1,11
DC.L 0
DC.W 8
DC.W 1,12
DC.L 0
DC.W 8
DC.W 1,13
DC.L 0
DC.W 8
DC.W 1,14
DC.L 0
DC.W 8
DC.W 1,15
DC.L 0
DC.W 8
DC.W 1,16
DC.L 0
DC.W 8
DC.W -1
ENDPART
********************************************************************************
* F1 - Trace *
********************************************************************************
>PART 'f_trace'
f_trace: bsr init_trace
bra do_trace ;Befehl ausführen
f_trac1: bsr exit_trace
f_trac2: move.w trace_delay(A4),D0
f_trac5: move #0,CCR
dbra D0,f_trac5 ;Trace-Verzögerung
clr.l merk_pc(A4)
jsr hunt_pc ;Bildschirm aufgebaut & PC auf dem Schirm?
move.w D7,-(SP)
bpl.s f_trac4 ;dann nicht neu ausgeben
clr.w (SP) ;Cursor in Zeile 0
move.w trace_flag(A4),D0 ;List oder Disassemble
subq.w #1,D0
bmi.s f_trac3 ;=0 => List
beq.s f_trac6 ;=1 => Disassemble
tst.l ass_vector(A4) ;Assembler da?
beq.s f_trac3 ;Nein! => dann Listen
bsr f_dir ;Source-List
bra.s f_trac4
f_trac6: bsr f_disass ;Ab PC disassemblieren
bra.s f_trac4
f_trac3: bsr f_list ;Ab PC listen
f_trac4: move.w (SP)+,zeile(A4)
clr.w spalte(A4)
move.l _pc(A4),default_adr(A4)
bra all_normal ;Das war's
ENDPART
********************************************************************************
* S+F2 - Don't trace Subroutine *
********************************************************************************
>PART 'f_trasub'
f_trasub: movea.l _pc(A4),A6
move.b (A6),D0
cmp.b #$61,D0
beq.s f_do_pc ;BSR ausführen
move.w (A6),D0 ;zu tracender Opcode
and.w #$FFC0,D0
cmp.w #$4E80,D0
beq.s f_do_pc ;JSR ausführen
bra.s f_trace ;Befehl tracen
ENDPART
********************************************************************************
* F2 - Do PC *
********************************************************************************
>PART 'f_do_pc'
f_do_pc: lea f_trac2(PC),A0
move.l A0,jmpdispa(A4) ;Rücksprungadr setzen
bsr in_trace_buff ;Register in den Trace-Buffer
bra cmd_call1 ;Nächsten Befehl ausführen
ENDPART
********************************************************************************
* F3 - Trace until RTS Shift+F3 - Trace until RTE/R *
********************************************************************************
>PART 'f_trarts/e'
f_trarte: moveq #2,D7 ;Stackoffset für RTE/RTR
bra.s f_trara
f_trarts: moveq #0,D7 ;Kein Stackoffset für RTS
f_trara: lea f_trac1(PC),A0
move.l A0,jmpdispa(A4) ;Rücksprungadr setzen
bsr in_trace_buff ;Register in den Trace-Buffer
movea.l _ssp(A4),A0
btst #5,_sr(A4) ;User- oder Supervisor-Stack?
bne.s f_trar1
movea.l _usp(A4),A0
f_trar1: move.l 0(A0,D7.w),merk_stk(A4)
lea login_trace,A1
move.l A1,0(A0,D7.w) ;Rücksprungadresse überschreiben
bra go_pc ;Los geht's
ENDPART
********************************************************************************
* F4 - Trace all *
********************************************************************************
>PART 'f_traall'
f_traall: bsr init_trace
bsr do_trace_all ;Befehl ausführen
bra f_trac1
ENDPART
********************************************************************************
* F5 - Skip PC *
********************************************************************************
>PART 'f_skip'
f_skip: bsr in_trace_buff ;Register in den Trace-Buffer
movea.l _pc(A4),A6 ;Befehlslänge am PC ermitteln
jsr get_dlen ;Befehlslänge ermitteln
move.l A6,_pc(A4) ;neuen PC setzen
bsr set_reg ;und neu setzen
bra f_trac2
ENDPART
********************************************************************************
* F6 - Hexdump *
********************************************************************************
>PART 'f_hexdump'
f_hexdump: movem.l D0-A6,-(SP)
movea.l reg_pos(A4),A5
move.l 64(A5),D1 ;aktuellen PC holen
bclr #0,D1
movea.l D1,A6
move.w #-1,zeile(A4) ;Cursor home (s.u.)
move.w down_lines(A4),D7
subq.w #1,D7
f_hexd0: move.w D7,-(SP)
addq.w #1,zeile(A4)
moveq #0,D3
bsr cmd_dump7 ;Hexdump ausgeben
move.w (SP)+,D7
dbra D7,f_hexd0
clr.w zeile(A4)
move.w #10,spalte(A4) ;Cursor in die 1.Zeile
movem.l (SP)+,D0-A6
rts
ENDPART
********************************************************************************
* F7/F8 - List/Disassemble *
********************************************************************************
>PART 'f_list/disass'
f_list: st list_flg(A4)
clr.w trace_flag(A4)
bra.s f_list0
f_disass: sf list_flg(A4)
move.w #1,trace_flag(A4)
f_list0: movem.l D0-A6,-(SP)
movea.l reg_pos(A4),A5
move.l 64(A5),D1 ;aktuellen PC holen
btst #0,D1
beq.s f_disa1
addq.l #1,D1
f_disa1: movea.l D1,A6
move.w #-1,zeile(A4) ;Cursor home (s.u.)
move.w down_lines(A4),D7
subq.w #1,D7
f_disa0: move.l D7,-(SP)
addq.w #1,zeile(A4)
bsr do_disass
move.l (SP)+,D7
dbra D7,f_disa0
clr.w zeile(A4)
move.w #10,spalte(A4) ;Cursor in die 1.Zeile
movem.l (SP)+,D0-A6
sf list_flg(A4)
rts
ENDPART
********************************************************************************
* F9 - Sourcecode-List *
********************************************************************************
>PART 'f_dir'
f_dir: tst.l ass_vector(A4) ;Assembler da?
beq.s f_list ;Nein! => dann Listen
move.w #2,trace_flag(A4)
movem.l D0-A6,-(SP)
movea.l reg_pos(A4),A5
movea.l 64(A5),A6 ;aktuellen PC holen
move.l A6,D0
addq.l #1,D0
and.b #-2,D0 ;EVEN
movea.l D0,A6
jsr check_read ;Zugriff erlaubt?
bne.s src_list1 ;Ende, wenn nicht
movea.l basep(A4),A0 ;Basepage des zu debuggenden Programms
cmp.l $18(A0),D0 ;BSS-Segment-Adr erreicht?
bhs.s src_list2 ;dann Ende
sub.l 8(A0),D0 ;- TEXT-Segment-Start
bmi.s src_list2 ;kleiner als TEXT-Segment => Ende
movea.l ass_vector(A4),A5
jsr -6(A5) ;Offset => Zeilennummer
move.w D0,D6 ;Zeilennummer merken
clr.w zeile(A4) ;Cursor home
st testwrd(A4) ;Ausgabe in den Buffer A0
move.w down_lines(A4),D7
subq.w #1,D7 ;Zeilenanzahl auf dem Screen
src_list0: move.w D6,D0 ;Zeilennummer setzen
jsr -18(A5) ;Zeile D0 nach A0
addq.l #1,D0
bne.s src_list3
lea src_list_null(PC),A0 ;Leerstring ausgeben
bra.s src_list4
src_list3: move.l A0,-(SP)
lea spaced2(A4),A0
movem.l D0-D7/A1-A6,-(SP)
move.l A6,D1
jsr @anf_adr(A4) ;Adresse am Zeilenanfang
movem.l (SP)+,D0-D7/A1-A6
movea.l (SP)+,A1
move.b #'&',(A0)+ ;Kennung = Sourcetext Listing
moveq #4,D4 ;5 Stellen
moveq #0,D1
move.w D6,D1 ;Zeilennummer
bsr dezw_out_b ;Zahl ausgeben
moveq #65,D1 ;max.Zahl an Zeichen = 66
src_list1: move.b (A1)+,(A0)+ ;Buffer umkopieren
dbeq D1,src_list1
clr.b (A0) ;Zeilenende erzwingen
src_list4: lea spaced2(A4),A0
move.w zeile(A4),D0
jsr write_line ;Ergebnis des Disassemblers ausgeben
addq.w #1,D6 ;nächste Zeile
addq.w #1,zeile(A4) ;Zeilennummer+1
dbra D7,src_list0 ;schon alle Zeilen?
src_list2: clr.w zeile(A4)
move.w #10,spalte(A4) ;Cursor in die 1.Zeile
sf testwrd(A4) ;Ausgabe wieder normal
movem.l (SP)+,D0-A6
rts
src_list_null: DC.B '&',0
ENDPART
********************************************************************************
* Zeilen in D0 ausgeben *
********************************************************************************
>PART 'src_out'
src_out: move.l D0,D7 ;Zeilennummer merken
jsr -12(A5) ;Zeilennummer => Offset
movea.l basep(A4),A6
movea.l 8(A6),A6 ;TEXT-Segment-Adresse
tst.l D0
bmi.s src_out0
adda.l D0,A6 ;+TEXT-Segment-Adresse
src_out0: move.l D7,D0 ;Zeilennummer zurück
jsr -18(A5) ;Zeile D0 nach A0
addq.l #1,D0 ;Ende des Sourcetextes?
beq.s src_out1 ;Ja! => raus
st testwrd(A4) ;Ausgabe in den Buffer A0
move.l A0,-(SP)
lea spaced2(A4),A0
movem.l D0-D7/A1-A6,-(SP)
move.l A6,D1
jsr @anf_adr(A4) ;Adresse am Zeilenanfang
movem.l (SP)+,D0-D7/A1-A6
movea.l (SP)+,A1
move.b #'&',(A0)+ ;Kennung = Sourcetext Listing
moveq #4,D4 ;5 Stellen
moveq #0,D1
move.w D7,D1 ;Zeilennummer
bsr dezw_out_b ;Zahl ausgeben
moveq #65,D1 ;max.Zahl an Zeichen = 66
src_out2: move.b (A1)+,(A0)+ ;Buffer umkopieren
dbeq D1,src_out2
clr.b (A0) ;Zeilenende erzwingen
lea spaced2(A4),A0
move.w zeile(A4),D0
jsr write_line ;Ergebnis des Disassemblers ausgeben
sf testwrd(A4) ;Ausgabe in den Buffer A0
move #$FF,CCR ;Z-Flag setzen
rts
src_out1: move #0,CCR ;Z-Flag löschen
rts
ENDPART
********************************************************************************
* F10 - Switch Screen *
********************************************************************************
>PART 'f_switch'
f_switch: jsr @desel_menü(A4) ;evtl. selektierten Menüeintrag deselektieren
lea debugger_scr(A4),A0
jsr check_screen ;der Debugger-Screen an?
bne.s f_switch1 ;Nein! =>
jmp @page2(A4) ;Originale Grafikseite
f_switch1: jmp @page1(A4) ;Debuggerscreen
ENDPART
********************************************************************************
* S+F1 - 68020 Emulator *
********************************************************************************
>PART 'f_68020emu'
f_68020emu: lea emu68020(PC),A0
move.l A0,$24.w ;68020-Trace-Vektor
bsr init_trace
bsr do_trace1 ;los geht's
bra f_trac1 ;und fertig mit Trace
emu68020: move #$2700,SR ;Bitte nicht stören... (IRQs aus)
movem.l D0/A0,-(SP) ;Register retten
movea.l 10(SP),A0 ;Den PC holen
move.w (A0),D0 ;Den Befehl am PC holen
cmp.w #$4E73,D0 ;RTE
beq.s emu680203
cmp.w #$4E75,D0 ;RTS
beq.s emu680203
cmp.w #$4E77,D0 ;RTR
beq.s emu680203
andi.w #$F0F8,D0 ;Condition & Register ausmaskieren
cmp.w #$50C8,D0 ;DBcc
beq.s emu680203
andi.w #$F000,D0 ;Condition & sprungweite ausmaskieren
cmp.w #$6000,D0 ;Bcc
beq.s emu680203
move.w (A0),D0 ;Den Befehl am PC nochmal holen
andi.w #$FFF0,D0 ;TRAP-Nummer ausmaskieren
cmp.w #$4E40,D0 ;TRAP
beq.s emu680203
andi.w #$FFC0,D0 ;EA erstmal ausmaskieren
cmp.w #$4EC0,D0 ;JMP
beq.s emu680202
cmp.w #$4E80,D0 ;JSR
beq.s emu680202
emu680201: movem.l (SP)+,D0/A0 ;Register zurück
bset #7,(SP) ;Trace wieder an (nicht vergessen)
rte ;und weiter
emu680202: move.w (A0),D0
and.w #%111111,D0 ;EA isolieren
cmp.w #%111011,D0
bhi.s emu680201 ;#, etc (68020) ist nicht erlaubt
cmp.w #%101000,D0 ;d(An), absolut, etc. => Abbruch
bhs.s emu680203 ;Hier war ein Fehler => bls.s !!!
and.w #%111000,D0 ;Modus isolieren
cmp.w #%10000,D0
bne.s emu680201 ;wenn nicht (An) dann weiter
emu680203: movem.l (SP)+,D0/A0 ;Hier soll nun abgebrochen werden
bra do_trace_excep ;und beenden
ENDPART
********************************************************************************
* S+F9 - Info *
********************************************************************************
>PART 'f_info'
f_info: lea info_rsc(PC),A1
move.w #10,6(A1) ;10 Zeilen hoch
move.w #8,12(A1) ;Button in Zeile 8
move.w #-1,info_r1 ;Baum kürzen
st testwrd(A4)
lea info_txt1+28(PC),A0
move.l basepage(A4),D1
bsr hexlout
lea info_txtx+28(PC),A0
move.l end_adr(A4),D1
bsr hexlout
lea info_txt2+28(PC),A0
move.l first_free(A4),D1
bsr hexlout
lea info_txta+28(PC),A0
move.l save_data+1070(A4),D1
bsr hexlout
move.l basep(A4),D0
beq f_info1
movea.l D0,A2 ;Programmbasepage merken
move.w #14,6(A1) ;14 Zeilen hoch
move.w #12,12(A1) ;Button in Zeile 12
move.w #1,info_r1
move.w #1,info_r2 ;Baum wieder verlängern
lea info_txt5(PC),A0
move.l A0,info_r3
lea 28(A0),A0
move.l 8(A2),D1
bsr hexlout ;TEXT-Base einsetzen
lea info_txt6(PC),A0
move.l A0,info_r4
lea 28(A0),A0
move.l $10(A2),D1
bsr hexlout ;DATA-Base einsetzen
lea info_txt7+28(PC),A0
move.l $18(A2),D1
bsr hexlout ;BSS-Base einsetzen
lea info_txt8+28(PC),A0
move.l $18(A2),D1
add.l $1C(A2),D1
bsr hexlout ;Last used Adr
move.w #-1,info_r5
move.l sym_size(A4),D2
beq f_info2 ;Das war vorerst alles
move.w #15,6(A1) ;15 Zeilen hoch
move.w #13,12(A1) ;Button in Zeile 13
move.w #1,info_r5
lea info_txt9+27(PC),A0
movea.l A0,A2
moveq #4,D0 ;max.5 Ziffern
f_info3: move.b #' ',(A0)+ ;Symbolwert löschen
dbra D0,f_info3
movea.l A2,A0
moveq #14,D1
bsr ldiv ;ein Eintrag ist 14 Bytes lang
move.l D2,D1
moveq #10,D2 ;Dezimalsystem
bsr numoutx
move.l #' ',D0
moveq #' ',D1
tst.b gst_sym_flag(A4)
beq.s f_info4
move.l #'(GST',D0
moveq #')',D1
f_info4: move.l D0,info_txts
move.b D1,info_txts+4
bra.s f_info2
f_info1: move.l merk_anf(A4),D1
beq.s f_info2
move.w #12,6(A1) ;12 Zeilen hoch
move.w #10,12(A1) ;Button in Zeile 10
move.w #1,info_r1
move.w #-1,info_r2 ;Baum auf halblang
lea info_txt3(PC),A0
move.l A0,info_r3
lea 28(A0),A0
bsr hexlout ;Startadresse einsetzen
lea info_txt4(PC),A0
move.l A0,info_r4
lea 28(A0),A0
move.l merk_end(A4),D1
subq.l #1,D1
bsr hexlout ;Endadresse einsetzen
f_info2: clr.b testwrd(A4)
movea.l A1,A0
jmp @form_do(A4)
info_rsc: DC.W 0,0,38,10,1
DC.W 16,12
DC.L ok_button
DC.W $26
DC.W 11,1
DC.L info_txt0
DC.W 8
DC.W 1,3
DC.L info_txt1
DC.W 8
DC.W 1,4
DC.L info_txtx
DC.W 8
DC.W 1,5
DC.L info_txt2
DC.W 8
DC.W 1,6
DC.L info_txta
DC.W 8
info_r1: DC.W 1,7
info_r3: DC.L info_txt5
DC.W 8
DC.W 1,8
info_r4: DC.L info_txt6
DC.W 8
info_r2: DC.W 1,9
DC.L info_txt7
DC.W 8
DC.W 1,10
DC.L info_txt8
DC.W 8
info_r5: DC.W 1,11
DC.L info_txt9
DC.W 8
DC.W -1
SWITCH sprache
CASE 0
info_txt9: DC.B 'Symbolanzahl '
info_txts: DC.B ' : ',0
info_txt0: DC.B 'Speicherbelegung:',0
info_txt1: DC.B 'Start des Debuggers :$xxxxxxxx',0
info_txtx: DC.B 'Ende des Debuggers :$xxxxxxxx',0
info_txt2: DC.B 'Start des freien Speichers:$xxxxxxxx',0
info_txta: DC.B 'Ende des freien Speichers :$xxxxxxxx',0
info_txt3: DC.B 'Start des Programms :$xxxxxxxx',0
info_txt4: DC.B 'Ende des Programms :$xxxxxxxx',0
info_txt5: DC.B 'Start des TEXT-Segments :$xxxxxxxx',0
info_txt6: DC.B 'Start des DATA-Segments :$xxxxxxxx',0
info_txt7: DC.B 'Start des BSS-Segments :$xxxxxxxx',0
info_txt8: DC.B 'Erste freie Adresse :$xxxxxxxx',0
ok_button: DC.B ' OK ',0
CASE 1
info_txt9: DC.B 'Number of Symbols ' ;~
info_txts: DC.B ' : ',0
info_txt0: DC.B 'Memorytable:',0
info_txt1: DC.B 'Start of the debugger :$xxxxxxxx',0
info_txtx: DC.B 'End of the debugger :$xxxxxxxx',0
info_txt2: DC.B 'Start of free memory :$xxxxxxxx',0
info_txta: DC.B 'End of free memory :$xxxxxxxx',0
info_txt3: DC.B 'Start of program :$xxxxxxxx',0
info_txt4: DC.B 'End of program :$xxxxxxxx',0
info_txt5: DC.B 'Start of TEXT-segment :$xxxxxxxx',0
info_txt6: DC.B 'Start of DATA-segment :$xxxxxxxx',0
info_txt7: DC.B 'Start of BSS-segment :$xxxxxxxx',0
info_txt8: DC.B 'first free adress :$xxxxxxxx',0
ok_button: DC.B ' OK ',0
ENDS
EVEN
ENDPART
********************************************************************************
* S+F9 - Toggle Mode (Overwrite/Insert) *
********************************************************************************
>PART 'f_togmode'
f_togmode: not.b ins_mode(A4) ;Mode umschalten
jmp set_ins_flag
ENDPART
********************************************************************************
* S+F10 - Quit? *
********************************************************************************
>PART 'f_quit'
f_quit: lea quit_rsc(PC),A0
jsr @form_do(A4)
subq.w #2,D0 ;Kein Ende
bne cmd_exit1 ;Das war's
rts
quit_rsc: DC.W 0,0,27,6,1
DC.W 1,1
DC.L stop_icn
DC.W $3303
DC.W 7,1
DC.L quit_txt1
DC.W 8
DC.W 7,2
DC.L quit_txt2
DC.W 8
DC.W 7,4
DC.L quit_txt3
DC.W $26
DC.W 17,4
DC.L quit_txt4
DC.W $24
DC.W -1
SWITCH sprache
CASE 0
quit_txt1: DC.B 'Möchten Sie den',0
quit_txt2: DC.B 'Debugger verlassen?',0
quit_txt3: DC.B ' JA ',0
quit_txt4: DC.B ' NEIN ',0
CASE 1
quit_txt1: DC.B 'Wanna quit this',0
quit_txt2: DC.B 'adventure?',0
quit_txt3: DC.B ' SURE ',0
quit_txt4: DC.B ' OH NO ',0
ENDS
EVEN
ENDPART
********************************************************************************
* Ausgaberoutinen (Systemunabhängig) *
********************************************************************************
********************************************************************************
* Hexausgabe in D1 *
********************************************************************************
>PART 'hex???out'
hexa2out: moveq #'$',D0
jsr @chrout(A4)
hexlout: swap D1 ;Longword in D1 ausgeben
bsr.s hexwout
swap D1
hexwout: rol.w #8,D1 ;Word in D1 ausgeben
bsr.s hexbout
rol.w #8,D1
hexbout: movem.l D0-D2/A6,-(SP) ;Byte in D1 ausgeben
lea hex2tab(PC),A6
tst.w small(A4)
bne.s hexbbut
lea hex_tab(PC),A6
hexbbut: moveq #0,D0
moveq #$0F,D2
and.w D1,D2
rol.b #4,D1
and.w #$0F,D1
move.b 0(A6,D1.w),D0
jsr @chrout(A4)
move.b 0(A6,D2.w),D0
jsr @chrout(A4)
movem.l (SP)+,D0-D2/A6
rts
hex_tab: DC.B '0123456789ABCDEF'
hex2tab: DC.B '0123456789abcdef'
ENDPART
********************************************************************************
* Zahl bzw. Label in D1 ausgeben *
********************************************************************************
>PART 'symbol_numout'
symbol_numout: bsr.s hunt_symbol
beq numout ;Z=1 => Kein Label
moveq #'.',D0
jsr @chrout(A4)
ENDPART
********************************************************************************
* Label ab A1 ausgeben *
********************************************************************************
>PART 'labelout'
labelout: move.l (A1),-(SP)
jsr @print_line(A4)
rts
ENDPART
********************************************************************************
* Testen ob ein Label den Wert D1 hat, dann Z=0 und A1=Zeiger auf Label *
* (Binäre Suchroutine) *
********************************************************************************
>PART 'hunt_symbol'
hunt_symbol: movem.l D0-D5,-(SP)
tst.l sym_size(A4) ;Symboltabelle überhaupt da?
beq.s hunt_symbol4 ;Nein! => kein Label möglich
movea.l sym_adr(A4),A1 ;Anfangsadresse der Symboltabelle
moveq #0,D5 ;Linke Grenze=0
move.l D1,D4
move.l sym_size(A4),D2 ;Rechte Grenze
moveq #14,D1
bsr ldiv ;ein Eintrag ist 14 Bytes lang
move.l D4,D1
hunt_symbol1: move.w D5,D4 ;linke Grenze
add.w D2,D4 ;+rechte Grenze
lsr.w #1,D4 ;durch 2
moveq #0,D0 ;evtl. ist die Label > 64k
move.w D4,D0 ;= neuer Index
mulu #14,D0 ;mal Breite eines Eintrags
cmp.l 10(A1,D0.l),D1 ;Wert vergleichen
bhi.s hunt_symbol3 ;gesuchte Adr > Tabellenadr
blo.s hunt_symbol2 ;gesuchte Adr < Tabellenadr
lea 0(A1,D0.l),A1 ;Gefunden!
move #0,CCR
movem.l (SP)+,D0-D5
rts
hunt_symbol2: move.w D4,D2 ;Rechte Grenze=Index
cmp.w D5,D2
beq.s hunt_symbol4 ;Linke=rechte Grenze => nicht gefunden
bra.s hunt_symbol1 ;Weiter suchen
hunt_symbol3: move.w D4,D5
addq.w #1,D5 ;Linke Indexgrenze erhöhen
cmp.w D5,D2 ;Linke=rechte Grenze => nicht gefunden
bne.s hunt_symbol1 ;Weiter suchen
hunt_symbol4: lea 0(A1,D0.l),A1 ;letzte Position
move #$FF,CCR ;Nichts gefunden => normale Zahl
movem.l (SP)+,D0-D5
rts
ENDPART
********************************************************************************
* Dezimal-Zahl in D1 ausgeben *
* Anzahl der Stellen in D4 *
********************************************************************************
>PART 'dezw_out'
dezw_out: movem.l D0-D5/A3,-(SP)
lea dez_tab(PC),A3 ;Zeiger auf die Tabelle (s.u.)
move.w D4,D5 ;Anzahl der Stellen-1
add.w D5,D5
add.w D5,D5 ;mal 4 (schneller als LSL.W #2,D5 !)
lea 4(A3,D5.w),A3 ;Tabellenzeiger auf die Stellenzahl
moveq #' ',D5 ;führende Nullen als Space
dezw_o1: move.l -(A3),D3 ;Wert aus der Tabelle holen
moveq #-'0',D2 ;wird zu -'1',-'2',-'3', ...
dezw_o2: sub.l D3,D1 ;Tabellenwert n mal abziehen
dbmi D2,dezw_o2 ;Unterlauf? Nein! =>
neg.b D2 ;z.B. -'1' => '1'
move.b D2,D0
cmp.b #'0',D0 ;eine Null?
beq.s dezw_o4 ;Ja! =>
moveq #'0',D5 ;ab nun werden Nullen als "0" ausgegeben
dezw_o3: jsr @chrout(A4) ;das Zeichen in D0 ausgeben
add.l D3,D1 ;den Unterlauf (s.o.) zurücknehmen
dbra D4,dezw_o1 ;schon alle Stellen ausgeben? Nein! =>
movem.l (SP)+,D0-D5/A3
rts
dezw_o4: move.w D5,D0 ;Zeichen für die Null holen
tst.w D4 ;letzte Ziffer?
bne.s dezw_o3 ;Nein! => ausgeben
moveq #'0',D0 ;wenn der Wert 0 ist, zumindest eine '0'
bra.s dezw_o3 ;ausgeben!
dez_tab: DC.L 1,10,100,1000,10000,100000
DC.L 1000000,10000000,100000000,1000000000
ENDPART
********************************************************************************
* Dezimal-Zahl in D1 ausgeben (mit Führungsnullen!) *
* Anzahl der Stellen in D4 *
********************************************************************************
>PART 'dezw_out_b'
dezw_out_b: movem.l D0-D5/A3,-(SP)
lea dez_tab(PC),A3
move.w D4,D5
lsl.w #2,D5
lea 4(A3,D5.w),A3
moveq #' ',D5
dezw_o1_b: move.l -(A3),D3
moveq #$D0,D2
dezw_o2_b: sub.l D3,D1
dbmi D2,dezw_o2_b
neg.b D2
move.b D2,D0
moveq #'0',D5
jsr @chrout(A4)
add.l D3,D1
dbra D4,dezw_o1_b
movem.l (SP)+,D0-D5/A3
rts
ENDPART
********************************************************************************
* Zahl D1 im Dezimalsystem ausgeben *
********************************************************************************
>PART 'dezout'
dezout: moveq #10,D2 ;Zahlensystem auf dezimal
ENDPART
********************************************************************************
* Zahl (D1) mit Zahlenbasiszeichen (Basis = D2) ausgeben *
********************************************************************************
>PART 'numout'
numout: cmp.w #$10,D2
beq.s hexout ;falls Hexadezimal => in eigene Ausgabe
movem.l D0-D4/A6,-(SP)
moveq #10,D4
cmp.w D4,D2
bne.s numoutb ;Dezimalzahl?
cmp.l D4,D1 ;und die Zahl kleiner 10 ist
blo.s numout0 ;keine Zahlenbasis ausgeben
numoutb: bsr basout ;Zahlenbasiszeichen nach D0 holen
jsr @chrout(A4) ;und ausgeben
bra.s numout0 ;Zahl gemäß der Basis ausgeben
ENDPART
********************************************************************************
* Hexzahl in D1 ausgeben *
********************************************************************************
>PART 'hexout'
hexout: movem.l D0-D4,-(SP)
moveq #0,D4
moveq #-1,D2
moveq #7,D3 ;max.8 Ziffern
cmp.l #10,D1 ;und die Zahl kleiner 10 ist
blo.s hexouta ;keine Zahlenbasis ausgeben
move.b hexbase(PC),D0
jsr @chrout(A4)
hexouta: rol.l #4,D1
move.b D1,D0
andi.w #$0F,D0
tst.b D2 ;1.Ziffer <> "0" bereits ausgegeben?
beq.s hexoutb
tst.b D0
beq.s hexoutd ;Führungsnullen unterdrücken
moveq #0,D2 ;ab nun alle Ziffern ausgeben
hexoutb: addi.w #$30,D0
cmp.b #'9',D0
bls.s hexoutc ;Nibble in D0 nach Hexziffer
addq.w #7,D0
hexoutc: jsr @chrout(A4) ;und Ziffer ausgeben
moveq #-1,D4
hexoutd: dbra D3,hexouta
tst.w D4
bne.s hexoute ;Nichts ausgeben?
moveq #'0',D0
jsr @chrout(A4) ;Zumindest doch eine Null
hexoute: movem.l (SP)+,D0-D4
rts
ENDPART
********************************************************************************
* Zahl (D1) zur Zahlenbasis D2 ausgeben *
********************************************************************************
>PART 'numoutx'
numoutx: movem.l D0-D4/A6,-(SP)
numout0: movea.l SP,A6 ;Zahlenbasiszeichen (z.b. $) vorangestellt
numout1: bsr div ;durch Zahlenbasis teilen
move.w D3,-(SP) ;BCD-Ziffer auf Stack
tst.l D1
bne.s numout1 ;Zahl komplett auf dem Stack?
numout3: move.w (SP)+,D0 ;BCD-Ziffer holen
add.b #'0',D0
cmp.b #$3A,D0
blo.s numout2
addq.b #7,D0 ;in ASC-Ziffer oder Buchstaben wandeln
numout2: jsr @chrout(A4) ;Zeichen ausgeben
cmpa.l SP,A6
bne.s numout3 ;schon alles?
movem.l (SP)+,D0-D4/A6
rts
ENDPART
********************************************************************************
* Zeichenholroutinen (Systemunabhängig) *
********************************************************************************
********************************************************************************
* Liest ein Zeichen nach D0 (Überlesen von Spaces, ...) *
********************************************************************************
>PART 'get'
get: moveq #0,D0
move.b (A0)+,D0 ;Zeichen holen
beq.s get2
cmp.b #':',D0 ;Zeilentrenner
beq.s get3
cmp.b #';',D0 ;Auch 'ne Endekennung
beq.s get2
cmp.b #' ',D0 ;Spaces werden überlesen
beq.s get
cmp.b #'a',D0
blo.s get1 ;kein Kleinbuchstabe
cmp.b #'z',D0
bhi.s get1 ;kein Kleinbuchstabe
and.b #$DF,D0
get1: tst.b D0
rts
get3: move.l A0,input_pnt(A4) ;dort geht es weiter...
get2: moveq #0,D0
subq.l #1,A0 ;Ändert ja keine Flags
rts
ENDPART
********************************************************************************
* Liegt D0 im Zahlensystem D2 ? *
********************************************************************************
>PART 'chkval'
chkval: sub.b #'0',D0 ;prüft d0 auf Gültigkeit im Zahlensystem d2
cmp.b #10,D0 ;kleiner 10?
blo.s chkval0 ;ja,ok
subq.b #7,D0 ;nein, 7 weg
cmp.b #10,D0 ;jetzt kleiner 10?
blo.s chkval1 ;ja, Fehler, Carry löschen
chkval0: cmp.b D2,D0 ;vergleichen mit Zahlenbasis
bhs.s chkval1
rts
chkval1: addi.b #$37,D0 ;restaurieren, da keine zahl
move #0,CCR
rts
ENDPART
********************************************************************************
* Testen, ob ein Komma oder Nullbyte folgt *
********************************************************************************
>PART 'chkcom'
chkcom: tst.b D0
beq.s chkcom1
cmp.b #',',D0
bne.s syn_err ;Fehler, wenn nicht
bsr.s get ;Nächstes Zeichen holen
move #0,CCR ;Alle Bits löschen, da Komma vorhanden
chkcom1: rts
syn_err: bra synerr
ENDPART
********************************************************************************
* Zahlenbasis gemäß des Zahlenbasiszeichens (in D0) nach D3 holen *
********************************************************************************
>PART 'numbar'
numbas: moveq #3,D3 ;wenn das Zzeichen in d0 ein Zahlbasiszeichen
numbas1: cmp.b numtab(PC,D3.w),D0 ;ist, Rückkehr mit der Zahlenbasis in d3
dbeq D3,numbas1 ;sonst negative=1
tst.w D3
bmi.s numbas2
move.b numtab1(PC,D3.w),D3
numbas2: rts
DC.B '›'
numtab: DC.B '%@.'
hexbase: DC.B '$'
numtab1: DC.B 2,8,10,16
EVEN
ENDPART
********************************************************************************
* Zahlenbasiszeichen gemäß der Zahlenbasis (in D2) nach D0 holen *
********************************************************************************
>PART 'basout'
basout: moveq #3,D0 ;holt zeichen für zahlbasis ($,@,...) in d0
basout1: cmp.b numtab1(PC,D0.w),D2 ;Space wenn keine gültige Zahlenbasis
dbeq D0,basout1
move.b numtab(PC,D0.w),D0
rts
ENDPART
********************************************************************************
* Parameter nach A2 und A3 holen *
* C=0, wenn 1.Parameter vorhanden *
* V=0, wenn 2.Parameter vorhanden *
********************************************************************************
>PART 'get_parameter'
get_parameter: suba.l A2,A2 ;holt zwei Zahlenwerte in A2 und A3
suba.l A3,A3 ;wenn nicht angegeben, ist er null
move.w #3,-(SP) ;Flagbyte für kein Parameter angegeben
bsr get ;1.Zeichen holen
beq.s get_parameter2 ;fertig, da keine Parameter
cmp.b #',',D0
beq.s get_parameter1 ;ja
bsr get_term
movea.l D1,A2 ;1.Parameter nach A2
andi.w #$FE,(SP) ;C löschen
cmp.b #',',D0 ;Komma?
bne.s get_parameter2 ;nein, also kein 2.Parameter
get_parameter1: bsr get ;Komma überlesen
bsr get_term
movea.l D1,A3 ;2.Parameter nach A3
andi.w #$FD,(SP) ;V löschen
get_parameter2: move (SP)+,CCR
rts
ENDPART
********************************************************************************
* Parameter für Disassemble/Dump holen *
* A2 - Startadresse *
* A3 - Endadresse (gültig, wenn D2=0) *
* D2 - Zeilenanzahl *
********************************************************************************
>PART 'get2(x)adr'
get2adr: movea.l default_adr(A4),A2 ;Default-Startadresse
suba.l A3,A3 ;Default-Endadresse
get2xadr: move.w def_lines(A4),D2 ;Default-Zeilenanzahl
subq.w #1,D2
bsr get ;1.Zeichen holen
beq.s get2ad0 ;fertig, da keine Parameter
cmp.b #'#',D0 ;Zeilenanzahl?
beq.s get2ad2
cmp.b #'[',D0 ;Byteanzahl?
beq.s get2ad6
cmp.b #',',D0 ;Endadresse?
beq.s get2ad1
bsr get_term ;Neue Startadresse
movea.l D1,A2
tst.b D0
beq.s get2ad0
cmp.b #'[',D0 ;Byteanzahl?
beq.s get2ad6
cmp.b #'#',D0
beq.s get2ad2
cmp.b #',',D0 ;Jetzt muß es aber ein Komma sein!
bne syn_err
get2ad1: bsr get
cmp.b #'#',D0 ;Zeilenanzahl als 2.Parameter holen?
beq.s get2ad2
cmp.b #'[',D0 ;Byteanzahl?
beq.s get2ad6
bsr get_term ;Neue Endadresse holen
movea.l D1,A3
get2ad01: moveq #0,D2 ;Zeilenanzahl löschen
get2ad0: move.l A2,default_adr(A4) ;Neue Defaultadr setzen
tst.w D2
beq.s get2ad4 ;Keine Zeilen listen?
suba.l A3,A3 ;Endadresse ungültig machen
get2ad4: rts
get2ad2: bsr get
beq.s get2ad3 ;Wenn nichts folgt => 1 Zeile ist Default
bsr get_term ;Zeilenanzahl holen
subq.l #1,D1 ;für DBRA
move.l D1,D2
swap D1
tst.w D1
bne.s get2ad5 ;max.65535 Zeilen listen
bra.s get2ad0
get2ad3: moveq #0,D2 ;Zeilenanzahl = 1
move.l A2,default_adr(A4) ;Neue Defaultadr setzen
suba.l A3,A3 ;Endadresse ungültig machen
rts
get2ad6: bsr get
beq synerr ;Wenn nix folgt => Fehler
bsr get_term ;Byteanzahl holen
cmp.b #']',D0
bne.s get2ad7
bsr get ;evtl. "]" überlesen
get2ad7: lea 0(A2,D1.l),A3 ;Endadresse berechnen
bra.s get2ad01
get2ad5: bra illequa
ENDPART
********************************************************************************
* Parameter für Find und Fill holen *
********************************************************************************
>PART 'get_such_para'
get_such_para: cmp.b #',',D0
bne syn_err
moveq #0,D3 ;ein Byte eingegeben
move.b #2,find_cont0(A4)
lea data_buff(A4),A1
get_such_para1: bsr.s get_such_para4
cmp.b #',',D0
beq.s get_such_para1
tst.b D0
bne syn_err
get_such_para2: move.l A1,D3
lea data_buff(A4),A1
sub.l A1,D3
subq.w #1,D3 ;Länge-1
rts
get_such_para3: movem.l D1-D2/D4-D7/A2-A6,-(SP)
moveq #0,D3 ;ein Byte eingegeben
lea data_buff(A4),A1
bsr.s get_such_para4
movem.l (SP)+,D1-D2/D4-D7/A2-A6
bra.s get_such_para2
get_such_para4: bsr get ;1.Zeichen nach D0
cmp.b #$22,D0 ;Anführungszeichen?
beq.s get_such_para11 ;ja, ASCII holen
cmp.b #$27,D0
beq.s get_such_para11 ;ja, ASCII
cmp.b #'!',D0
beq.s get_such_para10 ;ist Mnemonic
bsr get_term ;Term nach D1 holen
cmp.b #'.',D0
bne.s get_such_para9 ;Größe ermitteln
bsr get ;Extension holen
move.w D0,D2 ;und retten
bsr get ;schon mal das Folgezeichen holen
cmp.b #'W',D2
beq.s get_such_para6
cmp.b #'L',D2
beq.s get_such_para5
cmp.b #'A',D2
beq.s get_such_para8
cmp.b #'B',D2
beq.s get_such_para7
bra syn_err
get_such_para5: swap D1
bsr.s get_such_para6
swap D1
get_such_para6: ror.w #8,D1 ;Word
move.b D1,(A1)+
ror.w #8,D1
get_such_para7: move.b D1,(A1)+ ;Bytezahl
rts
get_such_para8: addi.w #1,D3 ;3-Byte-Adresse
swap D1
move.b D1,(A1)+
swap D1
bra.s get_such_para6
get_such_para9: move.l D1,D2
swap D2
tst.w D2
bne.s get_such_para5 ;mehr als ein Word => Long!
swap D2
andi.w #$FF00,D2
bne.s get_such_para6 ;Word erkannt
bra.s get_such_para7 ;Nur ein Byte
get_such_para10:movea.l A1,A6 ;hier soll hinassembliert werden
bsr code_line ;und den Befehl assemblieren
movea.l A6,A1 ;nächste Adresse
rts
get_such_para11:moveq #-1,D5 ;Noch keine Eingabe
moveq #63,D4 ;maximal 64 Zeichen ASCII sind erlaubt
move.w D0,D2 ;" bzw. ' merken (String muß auch so enden)
get_such_para12:move.b (A0)+,D0 ;ASCII-Zeichen einlesen
beq.s get_such_para13 ;Zeilenende = Abbruch
cmp.w D2,D0 ;Endekriterium erreicht?
beq.s get_such_para13 ;dann Abbruch
moveq #0,D5
move.b D0,(A1)+
dbra D4,get_such_para12
bra syn_err ;zu lang!
get_such_para13:tst.w D5 ;überhaupt was eingelesen?
bne syn_err ;nein!
bra get
ENDPART
********************************************************************************
* Ausdruck auswerten, Ergebnis nach D1 *
********************************************************************************
>PART 'get_term'
get_term: moveq #'-',D1
cmp.b D0,D1 ;'--' ist gar nichts
bne.s get_term2
cmp.b (A0),D1
bne.s get_term2
get_term1: bsr get ;'-' bis zum Komma überlesen (2,4 oder 8)
beq.s get_term0
cmp.b #',',D0
bne.s get_term1
get_term0: rts
get_term2: tst.b D0
beq syn_err
movem.l D2-D7/A1-A6,-(SP)
bsr.s get_term4
moveq #-1,D2
get_term3: addq.w #1,D2
move.b get_term_tab(PC,D2.w),D3
addq.b #1,D3 ;Tabellenende = -1
beq synerr ;=> Falsches Formelende
cmp.b get_term_tab(PC,D2.w),D0 ;Formelendezeichen gefunden?
bne.s get_term3 ;Nein, weiter suchen
movem.l (SP)+,D2-D7/A1-A6
rts
get_term_tab: DC.B ',(.#=[]',$22,0,-1 ;Erlaubte Zeichen als Formelende
EVEN
get_term4: move.l D2,-(SP)
bsr w_eausd
move.l D1,D2
get_term5: cmp.b #'+',D0 ;Addition
bne.s get_term6
bsr get
bsr.s w_eausd
add.l D1,D2
bvs.s overflo
bra.s get_term5
overflo: bra overfl
get_term6: cmp.b #'-',D0 ;Subtraktion
bne.s get_term7
bsr get
bsr.s w_eausd
sub.l D1,D2
bvs.s overflo
bra.s get_term5
get_term7: cmp.b #'|',D0 ;OR
bne.s get_term8
bsr get
bsr.s w_eausd
or.l D1,D2
bra.s get_term5
get_term8: cmp.b #'^',D0 ;EOR
bne.s get_term9
bsr get
bsr.s w_eausd
eor.l D1,D2
bra.s get_term5
get_term9: cmp.b #'<',D0 ;SHL
bne.s get_term10
cmpi.b #'<',(A0)
bne.s get_term10
addq.l #1,A0
bsr get
bsr.s w_eausd
lsl.l D1,D2
bra.s get_term5
get_term10: cmp.b #'>',D0 ;SHR
bne.s get_term11
cmpi.b #'>',(A0)
bne.s get_term11
addq.l #1,A0
bsr get
bsr.s w_eausd
lsr.l D1,D2
bra.s get_term5
get_term11: move.l D2,D1
move.l (SP)+,D2
rts
w_eausd: move.l D2,-(SP)
bsr.s w_term
move.l D1,D2
w_eal: cmp.b #'*',D0 ;Multiplikation
bne.s w_ea1
bsr get
bsr.s w_term
bsr lmult ;D2=D1*D2
bra.s w_eal
w_ea1: cmp.b #'/',D0 ;Division
bne.s w_ea2
bsr get
bsr.s w_term
bsr ldiv ;D2.L = D2.L/D1.L
bra.s w_eal
w_ea2: cmp.b #'&',D0 ;AND
bne.s w_ea3
bsr get
bsr.s w_term
and.l D1,D2
bra.s w_eal
w_ea3: cmp.b #'%',D0 ;MODULO
bne.s w_eaend
bsr get
bsr.s w_term
bsr ldiv ;D1.L = D2 MOD D1
move.l D1,D2
bra.s w_eal
w_eaend: move.l D2,D1
move.l (SP)+,D2
rts
w_term: cmp.b #'!',D0 ;Logical NOT
bne.s w_term0
bsr get
bsr.s w_term0
tst.l D1
beq.s w_term4
moveq #0,D1
rts
w_term4: moveq #1,D1
rts
w_term0: cmp.b #'~',D0 ;NOT
bne.s w_term1
bsr get
bsr.s w_term1
not.l D1
rts
w_term1: cmp.b #'-',D0
beq.s w_term3
cmp.b #'+',D0
bne.s w_term2
bsr get ;Positives Vorzeichen überlesen
w_term2: bsr.s w_fakt
rts
w_term3: bsr get ;Negatives Vorzeichen
bsr.s w_fakt
neg.l D1
rts
w_fakt: move.l D2,-(SP)
cmp.b #'(',D0
beq.s w_fakt1
cmp.b #'{',D0
beq.s w_fakt2
bsr get_zahl ;Zahl nach D1 holen
move.l (SP)+,D2
rts
w_fakt1: bsr get ;Klammer überlesen
bsr get_term4 ;Ausdruck in der Klammer auswerten
cmp.b #')',D0
bne.s mistbra ;Klammer zu muß folgen
bsr get
move.l (SP)+,D2
rts
mistbra: bra misbrak
w_fakt2: bsr get
bsr get_term4
cmp.b #'}',D0 ;indirekt
bne.s mistbra
bsr get
moveq #0,D2 ;Word ist Default
cmp.b #'.',D0 ;Breite angegeben?
bne.s w_fakt4 ;Nein! => Word
bsr get
move.b D0,D3
bsr get
moveq #-1,D2 ;Long
cmp.b #'L',D3
beq.s w_fakt4
moveq #0,D2 ;Word
cmp.b #'W',D3
beq.s w_fakt4
moveq #1,D2 ;Byte
cmp.b #'B',D3
bne synerr ;dat war nix!
w_fakt4: movea.l $08.w,A1
movea.l $0C.w,A2
lea w_fakt3(PC),A3
move.l A3,$08.w ;Busfehler abfangen
move.l A3,$0C.w ;Adressfehler abfangen
movea.l D1,A3
moveq #0,D1
tst.b D2
bmi.s w_fakt5 ;Long
beq.s w_fakt7 ;Word
move.b (A3),D1 ;Byte
bra.s w_fakt6
w_fakt7: move.w (A3),D1 ;Word holen
bra.s w_fakt6
w_fakt5: move.l (A3),D1 ;Long holen
w_fakt6: move.l A1,8.w
move.l A2,$0C.w
move.l (SP)+,D2
rts
w_fakt3: move.l A1,$08.w
move.l A2,$0C.w
bra illequa ;Bäh, ein Fehler
ENDPART
********************************************************************************
* Zahl nach D1.L holen *
********************************************************************************
>PART 'get_zahl'
get_zahl: movem.l D2-D7/A1-A6,-(SP)
move.w D0,D2 ;aktuelles 1.Zeichen merken
lea vartab(PC),A1
lea w_legalc(PC),A3
movea.l A0,A2 ;Zeiger auf evtl.Variable oder Zahl merken
w_zahl0: moveq #-1,D1
move.w D2,D0 ;1.Zeichen zurückholen
tst.b (A1) ;Ende der Tabelle erreicht?
bmi w_zahlh ;es muß eine normale Zahl sein
w_zahl1: addq.w #1,D1
cmpi.b #' ',0(A1,D1.w) ;Eintrag gefunden?
beq.s w_zahl3 ;Ja!
tst.b 0(A1,D1.w)
beq.s w_zahl3 ;Eintrag ebenfalls gefunden
tst.w D1 ;1.Zeichen des Labels
beq.s w_zah10 ;da ist noch alles erlaubt
ext.w D0
bmi.s w_zahl1 ;Zeichen >127 sind nicht erlaubt
tst.b 0(A3,D0.w) ;Zeichen noch erlaubt?
bne.s w_zah11 ;Nein! => Abbruch, da ungleich
w_zah10: cmp.b 0(A1,D1.w),D0 ;Immer noch gleich?
w_zah11: move SR,D3
bsr get ;schon mal das nächste Zeichen holen
move.w D0,D4 ;Retten, falls es das letzte Zeichen war
move D3,CCR
beq.s w_zahl1 ;wenn gleich, nächstes Zeichen testen
lea 16(A1),A1 ;Zeiger auf die nächste Variable
movea.l A2,A0 ;Zeiger zurück
bra.s w_zahl0 ;Weiter suchen
w_zahl3: moveq #0,D1
move.w 8(A1),D0 ;Art der Variable
move.w 10(A1),D1 ;Übergabeparameter
movea.l 12(A1),A1 ;Pointer/Wert der Variablen
adda.l A4,A1
tst.w D0
beq.s w_zahl6 ;Direkter Wert (auch bei direkten Werten!)
cmp.w #2,D0
blo.s w_zahl5 ;Pointer auf den Wert
beq.s w_zahl7 ;Zeiger auf Pointer (+Offset)
cmp.w #4,D0
beq.s w_zahl8 ;Pointer auf Word
suba.l A4,A1 ;-Varbase, absolute Adresse
move.w D4,D0 ;Das letzte Zeichen zurückholen
jsr (A1) ;Routine ermittelt den Variablenwert
bra.s w_zahla
w_zahl5: move.l 0(A1,D1.w),D1 ;Zeiger auf Long
bra.s w_zahl9
w_zahl6: move.l A1,D1 ;Direkter Variablenwert
bra.s w_zahl9
w_zahl7: move.w D1,D2
move.l (A1),D1 ;Pointer holen
beq.s w_zahl9
movea.l D1,A1
move.l 0(A1,D2.w),D1 ;Variablenwert holen
bra.s w_zahl9
w_zahl8: move.w 0(A1,D1.w),D1 ;Pointer auf Word
w_zahl9: move.w D4,D0 ;Letztes Zeichen zurückholen
w_zahla: movem.l (SP)+,D2-D7/A1-A6
move #0,CCR ;alle Flags null, da keine Leereingabe
rts
w_zahlb: lea regs+32(A4),A1
moveq #8,D2
bsr chkval
bcc syn_err
cmp.w #7,D0
bne.s w_zahlg ;A7 = Stackpointer holen
bsr get ;Nächstes Zeichen schon mal holen
w_zahlc: btst #5,_sr(A4) ;Supervisor-Mode?
bne.s w_zahld
move.l _usp(A4),D1
rts
w_zahlbk: bsr get_term4 ;Breakpointnummer holen (rekursiv!)
tst.l D1
bmi.s ill_brk
cmp.l #15,D1
bhi.s ill_brk
lea breakpnt(A4),A1
mulu #12,D1 ;mal 12 als Index in die Tabelle
move.l 0(A1,D1.w),D1 ;Adresse des Breakpoints holen
beq.s ill_brk
rts
ill_brk: bra illbkpt
w_zahld: move.l _ssp(A4),D1
rts
w_zahle: moveq #0,D1
move.w _sr(A4),D1 ;SR holen
andi.w #$FF,D1 ;Für's CCR nur die unteren 8 Bits
rts
w_zahlf: lea regs(A4),A1
moveq #8,D2
bsr chkval
bcc syn_err
w_zahlg: cmp.w #8,D0 ;Register>7 ?
bcc syn_err
lsl.w #2,D0
move.l 0(A1,D0.w),D1 ;Register holen
bra get ;Nächstes Zeichen holen & Ende
w_zahlme: moveq #10,D2
bsr chkval
bcc syn_err
subq.w #1,D0
bpl.s w_zahlmx
moveq #9,D0
w_zahlmx: lea simple_vars(A4),A1
asl.w #2,D0
move.l 0(A1,D0.w),D1 ;Register holen
bra get ;Nächstes Zeichen holen & Ende
w_zahlsy: moveq #14,D1
move.l sym_size(A4),D2
bra ldiv ;ein Eintrag ist 14 Bytes lang
w_zahlcache: moveq #0,D1
tst.b prozessor(A4) ;68000 oder 68010?
ble.s w_zahlcachee ;dann raus hier
DC.W $4E7A,$1002 ;CACR holen
w_zahlcachee: bra get
w_zahlh: moveq #0,D0
move.b D2,D0 ;1.Zeichen zurückholen
movea.l A2,A0 ;Zeiger zurück auf die Zahl
cmp.b #$27,D0 ;ASCII-String?
beq.s w_zahll
cmp.b #$22,D0 ;ASCII-String?
beq.s w_zahll
moveq #$10,D2 ;Hexadezimal ist Default
bsr numbas ;?Zahlenbasiszeichen
bmi.s w_zahli ;nein
move.w D3,D2 ;ja, neue Zahlenbasis setzen
bsr get ;und nächstes Zeichen
w_zahli: bsr chkval ;lfd. zeichen gültig?
bcc.s w_zahlo ;nein, Fehler (evtl. Label?)
moveq #0,D1 ;Vorbesetzung von D1
w_zahlj: move.l D1,D3 ;D1.L * D2.B = D1.L
swap D3
mulu D2,D3
mulu D2,D1
swap D3
tst.w D3
bne overfl
add.l D3,D1
bcs overfl
add.l D0,D1 ;und addieren der Stelle
bcs overfl
bsr get ;nächste Stelle
bsr chkval ;gültig?
bcs.s w_zahlj ;ja, weiter
w_zahlk: movem.l (SP)+,D2-D7/A1-A6
move #0,CCR ;alle Flags null, da keine Leereingabe
rts
w_zahll: moveq #0,D1
w_zahlm: cmp.b (A0)+,D0 ;Zeichen gleich dem Anfangszeichen ' oder ` ?
beq.s w_zahln ;ja, fertig
rol.l #8,D1 ;Ergebnisregister 8 bit nach links shiften
tst.b D1 ;waren die höchsten 8bit schon belegt?
bne illequa ;ja, mehr als 4 byte ASCII, Error
move.b -1(A0),D1
beq.s w_zahlz ;null, Ende der Datei
cmp.b #13,D1 ;CR beendet ASCII
bne.s w_zahlm
w_zahlz: subq.l #1,A0 ;wieder eins abziehen,damit GET 0 bzw. CR holt
lsr.l #8,D1
w_zahln: bsr get
bra.s w_zahlk ;alles OK, Ende
w_zahlo: cmp.w #10,D2
bne illequa ;.Label => Dezimalsystem
;Symboltabelle des nachgeladenen Programms durchsuchen
lea w_legalc(PC),A5
movea.l A0,A3
subq.l #1,A3 ;Pointer auf 1.Zeichen des Labels
tst.l sym_size(A4)
beq.s w__zahl ;keine Symboltabelle => interne durchsuchen
movea.l A3,A2
movea.l sym_adr(A4),A1 ;Anfangsadresse der Symboltabelle
moveq #0,D7
moveq #0,D1
w_zahlp: movea.l (A1),A6 ;Zeiger auf das Label
w_zahlq: move.b (A2)+,D1 ;Zeichen der Eingabe holen
bmi.s w_zahlx ;Zeichen >127 sind stets erlaubt
tst.b 0(A5,D1.w) ;Ist das Zeichen im Label erlaubt?
bne.s w_zahlr ;Nein => gefunden
w_zahlx: cmp.b (A6)+,D1 ;Paßt der Kram überhaupt noch?
beq.s w_zahlq ;Weiter, wenn ja!
w_zahqq: movea.l A3,A2 ;Pointer zurück
lea 14(A1),A1 ;nächstes Label
cmpa.l sym_end(A4),A1
blo.s w_zahlp ;Ende erreicht? Nein!
bra.s w__zahl ;eigene Symboltabelle durchsuchen
w_zahlr: tst.b (A6) ;Label noch nicht zuende
bne.s w_zahqq ;das nächste Label testen
lea -1(A2),A0 ;Zeiger auf das erste Folgezeichen
bsr get ;das Folgezeichen holen
move.l 10(A1),D1 ;Wert des Labels holen
bra.s w_zahlk ;das war's schon
;Interne Symboltabelle durchsuchen
w__zahl: movea.l A3,A2
move.l sym_buffer(A4),D0 ;Symboltabelle geladen?
beq illequa ;Fehler, falls keine Symboltabelle
movea.l D0,A1
moveq #0,D7
moveq #0,D1
move.w sym_anzahl(A4),D0
bra.s w__zahll
w__zahlp: lea 8(A1),A6 ;Zeiger auf das Label
w__zahlq: move.b (A2)+,D1 ;Zeichen der Eingabe holen
bmi.s w__zahlx ;Zeichen >127 sind stets erlaubt
tst.b 0(A5,D1.w) ;Ist das Zeichen im Label erlaubt?
bne.s w__zahlr ;Nein => gefunden
w__zahlx: cmp.b (A6)+,D1 ;Paßt der Kram überhaupt noch?
beq.s w__zahlq ;Weiter, wenn ja!
w__zahqq: movea.l A3,A2 ;Pointer zurück
lea 32(A1),A1 ;nächstes Symbol
w__zahll: dbra D0,w__zahlp ;alle Symbole durch? Nein =>
bra illlabel ;Symbol nicht gefunden
w__zahlr: tst.b (A6) ;Symbol noch nicht zuende
bne.s w__zahqq ;das nächste Symbol testen
lea -1(A2),A0 ;Zeiger auf das erste Folgezeichen
bsr get ;das Folgezeichen holen
move.l (A1),D1 ;Wert des Symbols holen
bra w_zahlk ;das war's schon
w_legalc: DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DC.B 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1
DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0
DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1
DXSET 8,' '
vartab: DX.B 'SYMFLAG'
DC.W 4,0
DC.L bugaboo_sym
DX.B 'USERSCR'
DC.W 0,0
DC.L user_scr
DX.B 'INITSCR'
DC.W 0,0
DC.L user_scr
DX.B 'RING'
DC.W 4,0
DC.L ring_flag
DX.B 'SWITCH'
DC.W 4,0
DC.L smart_switch
DX.B 'SYMTAB'
DC.W 1,0
DC.L sym_buffer
DX.B 'TRACE'
DC.W 4,0
DC.L trace_flag
DX.B 'TDELAY'
DC.W 4,0
DC.L trace_delay
DX.B 'MIDI'
DC.W 4,0
DC.L midi_flag
DX.B 'OVERSCAN'
DC.W 4,0
DC.L overscan
DX.B 'CACHE'
DC.W 3,0
DC.L w_zahlcache
DX.B 'SHIFT'
DC.W 4,0
DC.L shift_flag
DX.B 'MEMCHECK'
DC.W 4,0
DC.L all_memory
DX.B 'CONVERT'
DC.W 0,0
DC.L convert_tab
DX.B 'ACT_PD'
DC.W 2,0
DC.L act_pd
DX.B 'CLICK'
DC.W 4,0
DC.L format_flag
DX.B 'KLICK'
DC.W 4,0
DC.L format_flag
DX.B 'IKBD'
DC.W 0,0
DC.L ikbd_string
DX.B 'SCROLLD'
DC.W 4,0
DC.L scroll_d
DX.B 'UTRACE'
DC.W 0,0
DC.L user_trace_buf
DX.B 'UT'
DC.W 0,0
DC.L user_trace_buf
DX.B 'COL0'
DC.W 4,0
DC.L col0
DX.B 'CONTERM'
DC.W 4,0
DC.L conterm
DX.B 'AESFLAG'
DC.W 4,0
DC.L no_aes_check
DX.B 'COL1'
DC.W 4,0
DC.L col1
DX.B 'CHECKSUM'
DC.W 4,0
DC.L checksum
DX.B 'SMALL'
DC.W 4,0
DC.L small
DX.B 'SIZE'
DC.W 4,0
DC.L def_size
DX.B 'LINES'
DC.W 4,0
DC.L def_lines
DX.B 'TEXT'
DC.W 2,8
DC.L basep
DX.B 'DATA'
DC.W 2,16
DC.L basep
DX.B 'BSS'
DC.W 2,24
DC.L basep
DX.B 'MEMBASE'
DC.W 1,0
DC.L first_free
DX.B 'START'
DC.W 1,0
DC.L merk_anf
DX.B 'SAVEAREA'
DC.W 0,0
DC.L default_stk
DX.B 'END'
DC.W 1,0
DC.L merk_end
DX.B 'BASEPAGE'
DC.W 1,0
DC.L basep
DX.B 'BP'
DC.W 1,0
DC.L basep
DX.B 'PC'
DC.W 1,0
DC.L _pc
DX.B 'USP'
DC.W 1,0
DC.L _usp
DX.B 'SP'
DC.W 3,0
DC.L w_zahlc
DX.B 'SYMBOLS'
DC.W 3,0
DC.L w_zahlsy
DX.B 'SSP'
DC.W 1,0
DC.L _ssp
DX.B 'SR'
DC.W 4,0
DC.L _sr
DX.B 'CCR'
DC.W 3,0
DC.L w_zahle
DX.B '*'
DC.W 1,0
DC.L default_adr
DX.B '^D'
DC.W 3,0
DC.L w_zahlf
DX.B '^A'
DC.W 3,0
DC.L w_zahlb
DX.B '^M'
DC.W 3,0
DC.L w_zahlme
DX.B '^B'
DC.W 3,0
DC.L w_zahlbk
DX.B 'DISBASE'
DC.W 4,0
DC.L disbase
DX.B 'BUFFER'
DC.W 1,0
DC.L dsk_adr
DX.B 'SEKBUFF'
DC.W 0,0
DC.L sekbuff
DX.B 'TRKBUFF'
DC.W 0,0
DC.L first_free
DX.B 'TRACK'
DC.W 4,0
DC.L dsk_track
DX.B 'SEKTOR'
DC.W 4,0
DC.L dsk_sektor
DX.B 'SECTOR'
DC.W 4,0
DC.L dsk_sektor
DX.B 'SIDE'
DC.W 4,0
DC.L dsk_side
DX.B 'DRIVE'
DC.W 4,0
DC.L dsk_drive
DX.B 'S'
DC.W 0,0
DC.L default_stk
DC.B -1
EVEN
ENDPART
********************************************************************************
* Filenamen nach fname holen (Pfad & Laufwerk setzen) *
********************************************************************************
>PART 'getnam'
getnam: bsr get ;Zeichen nach D0 holen
getnam_cont: cmp.b #'"',D0 ;ein gültiger Pfad/Filename?
bne synerr ;Nein! =>
lea fname(A4),A1 ;Platz für den Namen
getnam1: move.b (A0)+,D0
beq synerr ;Anführungszeichen fehlen!
cmp.b #'"',D0 ;Ende des Filenamens/Pfades?
beq.s getnam3 ;Ja! =>
cmp.b #'a',D0
blo.s getnam2 ;kein Kleinbuchstabe
cmp.b #'z',D0
bhi.s getnam2 ;kein Kleinbuchstabe
and.b #$DF,D0 ;in Großbuchstaben wandeln
getnam2: move.b D0,(A1)+
bra.s getnam1
getnam3: movea.l A0,A3 ;Zeiger auf folgendes Zeichen
clr.b (A1) ;Pfad/Filename mit Nullbyte abschlie·en
lea fname(A4),A0
cmpi.b #':',1(A0) ;Laufwerkskennung?
bne.s getnam5 ;Nein! =>
moveq #0,D0
move.b (A0),D0 ;Laufwerksbuchstaben holen
cmp.w #'P',D0
bhi illdrv
sub.w #'A',D0 ;Laufwerksoffset abziehen
bmi illdrv
move.l A0,-(SP)
move.w D0,-(SP)
move.w #$0E,-(SP) ;Dsetdrv()
tst.l basep(A4) ;Andere Programm geladen?
beq.s getnam4 ;Nein
trap #1 ;Pfad für's andere Programm setzen
getnam4: jsr do_trap_1 ;Pfad für den Debugger setzen
addq.l #4,SP
movea.l (SP)+,A0
addq.l #2,A0 ;Zeiger hinter die Laufwerkskennung
getnam5: movea.l A0,A2
movea.l A0,A1
getnam6: tst.b (A0)
beq.s getnam7
cmpi.b #'\',(A0)+
bne.s getnam6 ;Pfad?
movea.l A0,A1 ;evtl.Anfang des Filenamen merken
bra.s getnam6
getnam7: cmpa.l A0,A2
beq.s getnam9 ;nur Laufwerksbezeichnung angegeben
cmpi.b #'.',(A1) ;Filename: "."?
bne.s getnam71
addq.l #1,A1
cmpi.b #'.',(A1) ;Filename: ".."?
bne.s getnam71
addq.l #1,A1
getnam71: cmpa.l A1,A2
beq.s getnam9 ;Kein Pfad angegeben
move.b (A1),D7 ;1.Zeichen des Filenamens retten
clr.b (A1) ;Pfad mit Nullbyte terminieren
bsr.s do_mediach ;Media-Change auslösen
move.l A2,-(SP)
move.w #$3B,-(SP) ;Dsetpath()
tst.l basep(A4) ;Andere Programm geladen?
beq.s getnam8 ;Nein
trap #1 ;Pfad für's andere Programm setzen
getnam8: jsr do_trap_1 ;Pfad für den Debugger setzen
addq.l #6,SP
tst.w D0
bmi toserr
move.b D7,(A1)
getnam9: lea fname(A4),A0
movea.l A0,A2 ;Zeiger auf den Filenamen zurückgeben
getnam10: move.b (A1)+,(A0)+ ;Filenamen nach vorne kopieren
bne.s getnam10
clr.b (A0) ;Noch ein Nullbyte dran
tst.b (A2) ;kein Filenamen angegeben? Flag setzen
movea.l A3,A0
rts
ENDPART
********************************************************************************
* Media-Change auf dem aktuellen Laufwerk nötig? Dann ausführen *
********************************************************************************
>PART 'do_mediach'
do_mediach: movem.l D0-D2/A0-A2,-(SP)
move.w #$19,-(SP)
jsr do_trap_1 ;Dgetdrv()
addq.l #2,SP
move.w D0,a_mediach_drv
move.w D0,-(SP) ;Laufwerk D0
addq.w #1,D0
move.w D0,-(SP) ;Laufwerk D0+1
pea a_mediach_buf(PC)
move.w #$47,-(SP)
jsr do_trap_1 ;Dgetpath()
addq.l #8,SP
lea a_mediach_buf(PC),A0
do_mediach00: tst.b (A0)+ ;Ende des Pfades suchen
bne.s do_mediach00
clr.b (A0)
move.b #'\',-(A0) ;und den Pfad abschlie·en
clr.w -(SP) ;Sektor 0 lesen
move.w #1,-(SP) ;einen Sektor
move.l A4,-(SP)
addi.l #allg_buffer,(SP) ;Bufferadresse
clr.w -(SP) ;Lesen mit Media-Test
move.w #4,-(SP) ;Rwabs()
trap #13
lea 14(SP),SP
move.w a_mediach_drv(PC),D1 ;das Laufwerk zurückholen
tst.l D0 ;ein Fehler?
bmi.s do_mediach1 ;Ja! => Sofort einen Media-Change
movea.l #allg_buffer,A0
adda.l A4,A0
move.l 8(A0),D0 ;die Seriennummer des Bootsektors
lsl.w #2,D1 ;Laufwerk mal 4
movea.l #drv_table,A0
adda.l A4,A0
cmp.l 0(A0,D1.w),D0 ;Seriennummer noch gleich?
beq.s do_mediach3 ;Ja! => kein Media-Change => raus
move.l D0,0(A0,D1.w) ;neue Seriennummer merken
lsr.w #2,D1 ;Laufwerkno wieder restaurieren
do_mediach1: add.b #'A',D1
move.b D1,do_mediach10
move.l $0472.w,a_mediach_bpb
move.l $047E.w,a_mediach_med
move.l $0476.w,a_mediach_rw
move.l #do_mediach4,$0472.w
move.l #do_mediach6,$047E.w
move.l #do_mediach8,$0476.w
clr.w -(SP)
pea do_mediach10(PC)
move.w #$3D,-(SP)
trap #1 ;Fopen()
addq.w #8,SP
tst.l D0
bmi.s do_mediach2
move.w D0,-(SP)
move.w #$3E,-(SP)
trap #1 ;Fclose()
addq.w #4,SP
do_mediach2: cmpi.l #do_mediach4,$0472.w
bne.s do_mediach3
move.l a_mediach_bpb(PC),$0472.w
move.l a_mediach_med(PC),$047E.w
move.l a_mediach_rw(PC),$0476.w
do_mediach3: move.w #$19,-(SP)
jsr do_trap_1 ;Dgetdrv()
addq.l #2,SP
move.w D0,-(SP) ;Laufwerk retten
move.w a_mediach_drv(PC),-(SP)
move.w #$0E,-(SP)
jsr do_trap_1 ;Dsetdrv(Changedrive)
addq.l #4,SP
pea a_mediach_buf(PC)
move.w #$3B,-(SP)
jsr do_trap_1 ;Dsetpath(OldPath)
addq.l #6,SP
move.w #$0E,-(SP)
jsr do_trap_1 ;Dsetdrv(OldAktDrive)
addq.l #4,SP
movem.l (SP)+,D0-D2/A0-A2
rts
do_mediach4: move.w a_mediach_drv(PC),D0
cmp.w 4(SP),D0
bne.s do_mediach5
move.l a_mediach_bpb(PC),$0472.w
move.l a_mediach_med(PC),$047E.w
move.l a_mediach_rw(PC),$0476.w
do_mediach5: movea.l a_mediach_bpb(PC),A0
jmp (A0)
do_mediach6: move.w a_mediach_drv(PC),D0
cmp.w 4(SP),D0
bne.s do_mediach7
moveq #2,D0
rts
do_mediach7: movea.l a_mediach_med(PC),A0
jmp (A0)
do_mediach8: move.w a_mediach_drv(PC),D0
cmp.w 14(SP),D0
bne.s do_mediach9
moveq #-14,D0
rts
do_mediach9: movea.l a_mediach_rw(PC),A0
jmp (A0)
do_mediach10: DC.B 'x:\X',0
EVEN
a_mediach_drv: DS.W 1
a_mediach_bpb: DS.L 1
a_mediach_med: DS.L 1
a_mediach_rw: DS.L 1
a_mediach_buf: DS.B 128
ENDPART
********************************************************************************
* Extension eines Befehls (Längenangabe) nach D3 holen. *
********************************************************************************
>PART 'get_extension'
get_extension: cmp.b #'.',D0
bne.s get_ex2 ;keine Längenangabe
cmpi.b #' ',-2(A0) ;wenn Space vor dem Dezimalpunkt,dann Label
beq.s get_ex2 ;nix gut, keine Längenangabe
movem.l D0/A0,-(SP)
bsr get ;Befehlslänge einlesen
moveq #3,D3
get_ex1: cmp.b ext_tab(PC,D3.w),D0
beq.s get_ex3 ;gefunden
dbra D3,get_ex1
movem.l (SP)+,D0/A0 ;war eine Dezimalzahl, pointer zurück
get_ex2: moveq #0,D3 ;Byte für Mem.x als Default
move #$FF,CCR ;alle Flags eins
rts
get_ex3: addq.l #8,SP
bsr get ;nächstes Zeichen holen
move #0,CCR ;CCR auf null setzen, da gefunden
rts
ext_tab: DC.B 'BW L' ;Byte/Word/Long (Space ist nicht erlaubt)
ENDPART
********************************************************************************
* Rechenroutinen *
********************************************************************************
********************************************************************************
* Div-Long D1.L/D2.B -> D1.L Rest nach D3.W *
********************************************************************************
>PART 'div'
div: move.l D1,D3 ;div dividiert d1.l durch d2.b nach d1.l
ext.w D2 ;rest in d3, d2 unverändert
clr.w D3
swap D3
divu D2,D3
move.l D4,-(SP)
move.w D3,D4
move.w D1,D3
divu D2,D3
swap D4
move.w D3,D4
swap D3
move.l D4,D1
move.l (SP)+,D4
rts
ENDPART
*******************************************************************************
* LONG-Division : D2=D2/D1 D1=D2 MOD D1 *
*******************************************************************************
>PART 'ldiv'
ldiv: movem.l D0/D3-D4,-(SP)
tst.l D1
beq illequa
exg D1,D2
clr.w D4
tst.l D1
bge.s ldiv1
addq.w #3,D4
neg.l D1
ldiv1: tst.l D2
bge.s ldiv2
addq.w #1,D4
neg.l D2
ldiv2: moveq #1,D3
ldiv4: cmp.l D1,D2
bhs.s ldiv3
add.l D2,D2
add.l D3,D3
bra.s ldiv4
ldiv3: moveq #0,D0
ldiv6: cmp.l D1,D2
bhi.s ldiv5
or.l D3,D0
sub.l D2,D1
ldiv5: lsr.l #1,D2
lsr.l #1,D3
bhs.s ldiv6
cmp.w #3,D4
blt.s ldiv7
neg.l D1
ldiv7: lsr.l #1,D4
bcc.s ldiv8
neg.l D0
ldiv8: move.l D0,D2
movem.l (SP)+,D0/D3-D4
rts
ENDPART
********************************************************************************
* Long-Mult D2.L*D1.L -> D2.L *
********************************************************************************
>PART 'lmult'
lmult: movem.l D0-D1/D4-D5,-(SP)
moveq #0,D0
tst.l D1 ;Multiplikatior stets positiv
bpl.s lmult1
addq.b #1,D0
neg.l D1
lmult1: tst.l D2 ;Multiplikant stets positiv
bpl.s lmult2
addq.b #1,D0
neg.l D2
lmult2: move.l D2,D4 ;1.Faktor merken
mulu D1,D2 ;low-words multiplizieren
move.l D4,D5 ;1.Faktor nochmal merken
swap D4 ;high des 2.Faktors
mulu D1,D4
swap D4 ;Ergebnis umdrehen
tst.w D4 ;höheres Word testen
bne overfl
add.l D4,D2 ;und aufaddieren
bcs overfl
move.l D5,D4 ;1.Faktor reproduzieren
swap D1
mulu D1,D4 ;h-word d3 mal l-word d1
swap D4 ;Ergebnis swappen (wie oben)
tst.w D4 ;wieder höheres Word testen
bne overfl
add.l D4,D2 ;wieder aufaddieren
bcs overfl
swap D5 ;2.Faktor h-word nach unten
mulu D1,D5 ;h-words multiplizieren
bne overfl ;nicht null, erg. > $ffffffff
btst #0,D0
beq.s lmult3
neg.l D2
lmult3: movem.l (SP)+,D0-D1/D4-D5
rts
ENDPART
********************************************************************************
* Fehlermeldung ausgeben *
********************************************************************************
>PART 'Fehler ausgeben'
dskfull: tst.l D0 ;allgemeine Fehlermeldung?
bmi.s toserr
moveq #-117,D0 ;Disk full
bra.s toserr
illdrv: moveq #-46,D0 ;Illegales Laufwerk
bra.s toserr
timeouterr: moveq #-11,D0 ;Read-Fault
bra.s toserr
seekerr: moveq #-6,D0 ;Seek-Error
bra.s toserr
ioerr: move.w D0,-(SP)
cmpi.w #-17,(SP) ;Bei Hardwarefehlern
bhs.s ioerr3 ;das File NICHT schließen
tst.w _fhdle(A4)
blo.s ioerr3
move.w _fhdle(A4),-(SP)
move.w #$3E,-(SP)
jsr do_trap_1 ;Fclose()
addq.l #4,SP
bsr do_mediach ;Media-Change auslösen
ioerr3: move.w (SP)+,D0
toserr: ext.w D0
ext.l D0
move.l D0,D1
clr.w $043E.w ;Floppy-VBL wieder freigeben
lea terrtxt(PC),A0
bra.s toserr1
toserr2: tst.b (A0)+ ;Fehlertext überlesen
bne.s toserr2
toserr1: tst.b (A0)
beq.s toserr3 ;Fehler nicht gefunden (Ende der Tabelle)
cmp.b (A0),D0
bne.s toserr2 ;auf zum nächsten Fehler
toserr3: addq.l #1,A0 ;Zeiger auf den Fehlertext
tst.w spalte(A4)
beq.s toserr31
jsr crout
toserr31: clr.b device(A4) ;Druckerausgabe aus
move.l A0,-(SP) ;und merken
moveq #'-',D0
jsr @chrout(A4)
neg.l D1
moveq #10,D2 ;Dezimalsystem
bsr numoutx ;Fehlernummer ausgeben
jsr @space(A4)
moveq #':',D0
jsr @chrout(A4)
jsr @space(A4)
jsr @print_line(A4)
bra.s err1 ;Fehler beim Filezugriff
batch_mode_err: lea batch_errtxt(PC),A0
bra.s err
illbkpt: lea ill_bkpt(PC),A0
bra.s err
prn_err: lea prn_e(PC),A0
bra.s err
overfl: lea errtab(PC),A0
bra.s err
synerr: lea syntax(PC),A0
bra.s err
int_err: lea interr(PC),A0
bra.s err
misbrak: lea _misbra(PC),A0
bra.s err
no_syms: lea no_symt(PC),A0
bra.s err
file_er: lea file_e(PC),A0
bra.s err
fileer2: lea file_e2(PC),A0
bra.s err
illlabel: lea _illlab(PC),A0
bra.s err
no_prg: lea no_prg_(PC),A0
bra.s err
noallow: lea n_allow(PC),A0
bra.s err
no_bef: lea no_befx(PC),A0
bra.s err
illequa: lea illeqa(PC),A0
err: tst.b err_flag(A4)
beq.s err2
movea.l err_stk(A4),SP
jmp mausc9z
err2: clr.b device(A4) ;Druckerausgabe ausschalten
move.w zeile(A4),D0
jsr write_line
err1: jsr @crout(A4)
jsr clr_keybuff ;Tastaturbuffer leeren
sf do_resident(A4) ;AUTO-Resident löschen
bra all_normal
SWITCH sprache
CASE 0
batch_errtxt: DC.B '?Im Batch-Mode nicht erlaubt',0
no_befx: DC.B '?Unbekannter Befehl',0
interr: DC.B '?Interner Fehler (Bitte Eingabe notieren!)',0
n_allow: DC.B '?Nicht erlaubt',0
ill_bkpt: DC.B '?Illegaler Breakpoint',0
errtab: DC.B '?Überlauf',0
syntax: DC.B '?Syntax-Fehler',0
illeqa: DC.B '?Wert nicht erlaubt',0
_misbra: DC.B '?Klammer fehlt',0
_illlab: DC.B '?Label existiert nicht',0
no_symt: DC.B '?Keine Symboltabelle',0
prn_e: DC.B '?Welcher Drucker',0
file_e: DC.B '?Datei nicht mit FOPEN geöffnet',0
file_e2: DC.B '?Datei wurde bereits geöffnet',0
no_prg_: DC.B '?Es ist kein Programm geladen',0
terrtxt: DC.B -1,'Error',0
DC.B -2,'Drive not ready',0
DC.B -3,'Unknown command',0
DC.B -4,'CRC-error',0
DC.B -5,'Bad request',0
DC.B -6,'Seek error',0
DC.B -7,'Unknown media',0
DC.B -8,'Sector not found',0
DC.B -9,'No paper',0
DC.B -10,'Write fault',0
DC.B -11,'Read fault',0
DC.B -12,'General mishap',0
DC.B -13,'Write protect',0
DC.B -14,'Media change',0
DC.B -15,'Unknown device',0
DC.B -16,'Bad sectors',0
DC.B -17,'Insert disk',0
DC.B -32,'EINVFN',0
DC.B -33,'Datei nicht gefunden',0
DC.B -34,'Pfad nicht gefunden',0
DC.B -35,'ENHNDL',0
DC.B -36,'Zugriff verwährt',0
DC.B -37,'EIHNDL',0
DC.B -39,'Speicher voll',0
DC.B -40,'EIMBA',0
DC.B -46,'Illegales Laufwerk',0
DC.B -48,'ENSAME',0
DC.B -49,'ENMFIL',0
DC.B -64,'ERANGE',0
DC.B -65,'EINTRN',0
DC.B -66,'Illegales Programmformat',0
DC.B -67,'EGSBF',0
DC.B -117,'Disk voll',0
DC.B -118,'Datei zu kurz',0
DC.B 0,'Unbekannter TOS Fehler',0
CASE 1
batch_errtxt: DC.B '?Not allowed in batch-mode',0
no_befx: DC.B '?Unknown Command',0
interr: DC.B '?Internal Error (Write down your input!)',0
n_allow: DC.B '?Not allowed',0
ill_bkpt: DC.B '?Illegal Breakpoint',0
errtab: DC.B '?Overflow',0
syntax: DC.B '?Syntax error',0
illeqa: DC.B '?Value not allowed',0
_misbra: DC.B '?Braket missing',0
_illlab: DC.B "?Label don't existiert",0
no_symt: DC.B '?No Symboltable',0
prn_e: DC.B '?No Printer',0
file_e: DC.B "?Can't open file with FOPEN",0
file_e2: DC.B '?file already opened',0
no_prg_: DC.B '?No programm',0
terrtxt: DC.B -1,'Error',0
DC.B -2,'Drive not ready',0
DC.B -3,'Unknown command',0
DC.B -4,'CRC-error',0
DC.B -5,'Bad request',0
DC.B -6,'Seek error',0
DC.B -7,'Unknown media',0
DC.B -8,'Sector not found',0
DC.B -9,'No paper',0
DC.B -10,'Write fault',0
DC.B -11,'Read fault',0
DC.B -12,'General mishap',0
DC.B -13,'Write protect',0
DC.B -14,'Media change',0
DC.B -15,'Unknown device',0
DC.B -16,'Bad sectors',0
DC.B -17,'Insert disk',0
DC.B -32,'EINVFN',0
DC.B -33,'File not found',0
DC.B -34,'Path not found',0
DC.B -35,'ENHNDL',0
DC.B -36,'Access denied',0
DC.B -37,'EIHNDL',0
DC.B -39,'Less memory',0
DC.B -40,'EIMBA',0
DC.B -46,'Illegal Drive',0
DC.B -48,'ENSAME',0
DC.B -49,'ENMFIL',0
DC.B -64,'ERANGE',0
DC.B -65,'EINTRN',0
DC.B -66,'Illegal program format',0
DC.B -67,'EGSBF',0
DC.B -117,'Disk full',0
DC.B -118,'File too short',0
DC.B 0,'Unknown TOS-Error',0
ENDS
EVEN
ENDPART
********************************************************************************
* 68020/30/40 Cache löschen *
********************************************************************************
>PART 'clr_cache'
clr_cache: movem.l D0/A0/A4-A6,-(SP)
move SR,-(SP)
movea.l SP,A6 ;SP retten
lea $10.w,A5
movea.l (A5),A4 ;Illegal-Vektor retten
lea clr_cache1(PC),A0
move.l A0,(A5) ;neuen einsetzen
ori #$0700,SR
DC.L $4E7A0002 ;MOVE CACR,D0
or.w #$0808,D0 ;Cache löschen
DC.L $4E7B0002 ;MOVE D0,CACR
clr_cache1: move.l A4,(A5) ;Illegal-Vektor zurück