; ; Cursor V1.0 ; (c) 1990 by Jürgen Forster ; ; die Register D0-D7 und A0-A3 sind jederzeit von Funktionen, die ; ihre Parameter über den Stack bekommen, verfügbar. ; A4 zeigt auf eine lokale Variablentabelle ; A5 zeigt auf die Tabelle der globalen Variablen und konstanten Strings ; A6 zeigt auf die BASBASE-Struktur, muß gerettet werden! VERSION EQU 1 REVISION EQU 270 NOLIST INCLUDE exec/types.i INCLUDE exec/initializers.i INCLUDE exec/io.i INCLUDE exec/libraries.i INCLUDE exec/lists.i INCLUDE exec/resident.i INCLUDE exec/strings.i INCLUDE exec/memory.i INCLUDE exec/execbase.i INCLUDE exec/tasks.i INCLUDE libraries/dos.i INCLUDE libraries/dosextens.i INCLUDE intuition/intuition.i INCLUDE devices/inputevent.i INCLUDE devices/conunit.i INCLUDE offsets.i INCLUDE libmacros.i LIST XREF _CreatePort XREF _DeletePort XREF _CreateStdIO XREF _DeleteStdIO ; ********************************************************************** ; * * ; * Unterstützung der Library * ; * * ; ********************************************************************** STRUCTURE BASBASE,LIB_SIZE BPTR BASBASE_SEGLIST LABEL BASBASE_SIZEOF moveq #RETURN_FAIL,d0 rts ROMTag dc.w RTC_MATCHWORD dc.l ROMTag dc.l EndCode dc.b RTF_AUTOINIT dc.b VERSION dc.b NT_LIBRARY dc.b 0 dc.l bas_runtimeName dc.l idString dc.l Init bas_runtimeName dc.b 'bas_runtime.library',0 idString dc.b 'bas_runtime.library 1.0 (30 Mar 1990) (c) 1990 Jürgen Forster',CR,LF,0 even Init dc.l BASBASE_SIZEOF dc.l functable dc.l datatable dc.l InitLib functable dc.l OpenLib dc.l CloseLib dc.l ExpungeLib dc.l ExtFuncLib dc.l INIT__ dc.l END__ dc.l ABS_D_D dc.l ABS_I_I dc.l ABS_L_L dc.l ABS_R_R dc.l ADD_DD_D dc.l ADD_II_I dc.l ADD_LL_L dc.l ADD_RR_R dc.l ADD_TT_T dc.l AND_II_I dc.l AND_LL_L dc.l AREAFILL_I_ dc.l AREAFILL__ dc.l AREA_II_ dc.l ASC_T_I dc.l ATN_D_D dc.l ATN_R_R dc.l BEEP__ dc.l BREAKOFF__ dc.l BREAKON__ dc.l BREAKSTOP__ dc.l CALL_Z_ dc.l CHDIR_T_ dc.l CHECKINPUTEND__ dc.l CHR_I_T dc.l CIRCLE_IIIIRRR_ dc.l CIRCLE_IIIIRR_ dc.l CIRCLE_IIII_ dc.l CIRCLE_III_ dc.l CLEAR__ dc.l CLOSE_I_ dc.l CLOSE__ dc.l CLS__ dc.l COLLISIONOFF__ dc.l COLLISIONON__ dc.l COLLISIONSTOP__ dc.l COLLISION_I_I dc.l COLOR1_I_ dc.l COLOR2_I_ dc.l CONVERT_D_I dc.l CONVERT_D_L dc.l CONVERT_D_R dc.l CONVERT_I_D dc.l CONVERT_I_L dc.l CONVERT_I_R dc.l CONVERT_L_D dc.l CONVERT_L_I dc.l CONVERT_L_R dc.l CONVERT_R_D dc.l CONVERT_R_I dc.l CONVERT_R_L dc.l COS_D_D dc.l COS_R_R dc.l CSRLIN__I dc.l CVD_T_D dc.l CVI_T_I dc.l CVL_T_L dc.l CVL_T_R dc.l DATE__T dc.l DIMDOUB_FP_ dc.l DIMINT_FP_ dc.l DIMLONG_FP_ dc.l DIMREAL_FP_ dc.l DIMTEXT_FP_ dc.l DIMSHAREDDOUB_FP_ dc.l DIMSHAREDINT_FP_ dc.l DIMSHAREDLONG_FP_ dc.l DIMSHAREDREAL_FP_ dc.l DIMSHAREDTEXT_FP_ dc.l DIV_DD_D dc.l DIV_II_I dc.l DIV_LL_L dc.l DIV_RR_R dc.l DOUBLE_D_DD dc.l DOUBLE_I_II dc.l DOUBLE_L_LL dc.l DOUBLE_R_RR dc.l DOUBLE_T_TT dc.l ENDSUB__ dc.l EOF_I_I dc.l EQV_II_I dc.l EQV_LL_L dc.l EQ_DD_D dc.l EQ_II_I dc.l EQ_LL_I dc.l EQ_RR_R dc.l EQ_TT_I dc.l ERASE_f_ dc.l ERL__I dc.l ERROR_L_ dc.l ERR__I dc.l EXP_D_D dc.l EXP_R_R dc.l FILEINPUT_I_IT dc.l FILELINEINPUT_I_T dc.l FILEPRINTRETURN_I_I dc.l FILEPRINTTAB_I_I dc.l FILEPRINT_ID_I dc.l FILEPRINT_II_I dc.l FILEPRINT_IL_I dc.l FILEPRINT_IR_I dc.l FILEPRINT_IT_I dc.l FILES_T_ dc.l FILES__ dc.l FIX_D_D dc.l FIX_R_R dc.l FORGET_D_ dc.l FORGET_I_ dc.l FORGET_L_ dc.l FORGET_R_ dc.l FORGET_T_ dc.l FRE_I_L dc.l FRONTCOLOR__I dc.l GETCOLOR0__I dc.l GETDOUBELEMPOINTER_FP_L dc.l GETDOUBELEM_FP_D dc.l GETINPUTPART__T dc.l GETINTELEMPOINTER_FP_L dc.l GETINTELEM_FP_I dc.l GETLONGELEMPOINTER_FP_L dc.l GETLONGELEM_FP_L dc.l GETREALELEMPOINTER_FP_L dc.l GETREALELEM_FP_R dc.l GETTEXTELEMPOINTER_FP_L dc.l GETTEXTELEM_FP_T dc.l GETWINDOWSIZE__II dc.l GE_DD_D dc.l GE_II_I dc.l GE_LL_I dc.l GE_RR_R dc.l GE_TT_I dc.l GFXSTEP_II_II dc.l GOSUB_Z_ dc.l GOTO_Z_ dc.l GT_DD_D dc.l GT_II_I dc.l GT_LL_I dc.l GT_RR_R dc.l GT_TT_I dc.l HEX_L_T dc.l IF_IDD_D dc.l IF_III_I dc.l IF_ILL_L dc.l IF_IRR_R dc.l IF_ITT_T dc.l IF_IZ_ dc.l IMP_II_I dc.l IMP_LL_L dc.l INKEY__T dc.l INPUT_II_T dc.l INPUT__ dc.l INSTR_ITT_I dc.l INSTR_TT_I dc.l INT_D_D dc.l INT_R_R dc.l KILL_T_ dc.l LEFT_TI_T dc.l LEN_T_I dc.l LE_DD_D dc.l LE_II_I dc.l LE_LL_I dc.l LE_RR_R dc.l LE_TT_I dc.l LIBRARYCLOSE__ dc.l LIBRARY_T_ dc.l LINEBF_IIIII_ dc.l LINEB_IIIII_ dc.l LINEINPUT__T dc.l LINE_IIIII_ dc.l LOCATEX_I_ dc.l LOCATEY_I_ dc.l LOC_I_L dc.l LOF_I_L dc.l LOG_D_D dc.l LOG_R_R dc.l LPOS_I_I dc.l LPRINTRETURN__ dc.l LPRINTTAB__ dc.l LPRINT_D_ dc.l LPRINT_I_ dc.l LPRINT_L_ dc.l LPRINT_R_ dc.l LPRINT_T_ dc.l LT_DD_D dc.l LT_II_I dc.l LT_LL_I dc.l LT_RR_R dc.l LT_TT_I dc.l MENUOFF__ dc.l MENUON__ dc.l MENURESET__ dc.l MENUSTOP__ dc.l MENU_IIIT_ dc.l MENU_III_ dc.l MENU_I_I dc.l MID_TII_T dc.l MID_TI_T dc.l MKD_D_T dc.l MKI_I_T dc.l MKL_L_T dc.l MKS_R_T dc.l MOD_II_I dc.l MOD_LL_L dc.l MOUSEOFF__ dc.l MOUSEON__ dc.l MOUSESTOP__ dc.l MOUSE_I_I dc.l MUL_DD_D dc.l MUL_II_L dc.l MUL_LL_L dc.l MUL_RR_R dc.l NAME_TT_ dc.l NEG_D_D dc.l NEG_I_I dc.l NEG_L_L dc.l NEG_R_R dc.l NEXT_DDDZ_ dc.l NEXT_IIIZ_ dc.l NEXT_LLLZ_ dc.l NEXT_RRRZ_ dc.l NE_DD_D dc.l NE_II_I dc.l NE_LL_I dc.l NE_RR_R dc.l NE_TT_I dc.l NOT_I_I dc.l NOT_L_L dc.l OBJECT.AX_II_ dc.l OBJECT.AY_II_ dc.l OBJECT.CLIP_IIII_ dc.l OBJECT.CLOSE_I_ dc.l OBJECT.CLOSE__ dc.l OBJECT.HIT1_II_I dc.l OBJECT.HIT2_II_I dc.l OBJECT.OFF_I_ dc.l OBJECT.OFF__ dc.l OBJECT.ON_I_ dc.l OBJECT.ON__ dc.l OBJECT.PLANES1_II_I dc.l OBJECT.PLANES2_II_I dc.l OBJECT.PRIORITY_II_ dc.l OBJECT.SHAPE_II_ dc.l OBJECT.SHAPE_IT_ dc.l OBJECT.START_I_ dc.l OBJECT.START__ dc.l OBJECT.STOP_I_ dc.l OBJECT.STOP__ dc.l OBJECT.VX_II_ dc.l OBJECT.VX_I_I dc.l OBJECT.VY_II_ dc.l OBJECT.VY_I_I dc.l OBJECT.X_II_ dc.l OBJECT.Y_II_ dc.l OCT_L_T dc.l ONBREAKGOSUB_Z_ dc.l ONCOLLISIONGOSUB_Z_ dc.l ONERRORGOTO_Z_ dc.l ONGOSUB_IIZ_II dc.l ONGOTO_IIZ_II dc.l ONMENUGOSUB_Z_ dc.l ONMOUSEGOSUB_Z_ dc.l ONTIMERGOSUB_IZ_ dc.l OPENAPPEND_TI_ dc.l OPENINPUT_TI_ dc.l OPENOUTPUT_TI_ dc.l OPENREADWRITE_TI_ dc.l OR_II_I dc.l OR_LL_L dc.l PAINT_IIII_ dc.l PALETTE_IRRR_ dc.l PATTERN1_L_ dc.l PATTERN2_L_ dc.l PEEKL_L_L dc.l PEEKW_L_I dc.l PEEK_L_I dc.l POINT_II_I dc.l POKEL_LL_ dc.l POKEW_LI_ dc.l POKE_LI_ dc.l POS_I_I dc.l POT_DD_D dc.l POT_RR_R dc.l PRESET_III_ dc.l PRINTQMARK__ dc.l PRINTRETURN__ dc.l PRINTTAB__ dc.l PRINT_D_ dc.l PRINT_I_ dc.l PRINT_L_ dc.l PRINT_R_ dc.l PRINT_T_ dc.l PSET_III_ dc.l RANDOMIZE_I_ dc.l RANDOMIZE__ dc.l READ__T dc.l RESTORE_I_ dc.l RESTORE__ dc.l RESUMENEXT__ dc.l RESUME_Z_ dc.l RESUME__ dc.l RETURN_Z_ dc.l RETURN__ dc.l RIGHT_TI_T dc.l RND_I_R dc.l RND__R dc.l RUN_Z_ dc.l RUN__ dc.l SADD_T_L dc.l SCREENCLOSE_I_ dc.l SCREEN_IIIII_ dc.l SCROLL_IIIIII_ dc.l SETDOUBELEM_DFP_ dc.l SETINTELEM_IFP_ dc.l SETLINE_L_ dc.l SETLONGELEM_LFP_ dc.l SETMEM_L_ dc.l SETMID_tIIT_ dc.l SETMID_tIT_ dc.l SETREALELEM_RFP_ dc.l SETSTACK_L_ dc.l SETTEXTELEM_TFP_ dc.l SGN_D_I dc.l SGN_I_I dc.l SGN_L_I dc.l SGN_R_I dc.l SIN_D_D dc.l SIN_R_R dc.l SLEEP__ dc.l SOUNDRESUME__ dc.l SOUNDWAIT__ dc.l SOUND_IIII_ dc.l SPACE_I_T dc.l SQR_D_D dc.l SQR_L_I ; Nicht mehr benutzt dc.l SQR_R_R dc.l STICK_I_I dc.l STRIG_I_I dc.l STRING_II_T dc.l STRING_IT_T dc.l STR_D_T dc.l STR_I_T dc.l STR_L_T dc.l STR_R_T dc.l SUB_DD_D dc.l SUB_II_ dc.l SUB_II_I dc.l SUB_LL_L dc.l SUB_RR_R dc.l SWAP_dd_ dc.l SWAP_ii_ dc.l SWAP_ll_ dc.l SWAP_rr_ dc.l SWAP_tt_ dc.l SYSTEM__ dc.l TAN_D_D dc.l TAN_R_R dc.l TIMEROFF__ dc.l TIMERON__ dc.l TIMERSTOP__ dc.l TIMER__L dc.l TIME__T dc.l TRANSLATE_T_T dc.l TROFF__ dc.l TRON__ dc.l UCASE_T_T dc.l VAL_T_D dc.l WINDOWCLOSE_I_ dc.l WINDOWOUTPUT_I_ dc.l WINDOW_ITIIIIII_ dc.l WINDOW_I_L dc.l XOR_II_I dc.l XOR_LL_L dc.l -1 datatable INITBYTE LH_TYPE,NT_LIBRARY INITLONG LN_NAME,bas_runtimeName INITBYTE LIB_FLAGS,LIBF_SUMUSED!LIBF_CHANGED INITWORD LIB_VERSION,VERSION INITWORD LIB_REVISION,REVISION INITLONG LIB_IDSTRING,idString dc.l 0 InitLib move.l a5,-(sp) move.l d0,a5 move.l a0,BASBASE_SEGLIST(a5) move.l (sp)+,a5 rts OpenLib addq.w #1,LIB_OPENCNT(a6) bclr #LIBB_DELEXP,LIB_FLAGS(a6) move.l a6,d0 rts CloseLib moveq #0,d0 subq.w #1,LIB_OPENCNT(a6) bne.s StillInUse btst #LIBB_DELEXP,LIB_FLAGS(a6) beq.s NoDelExp bsr ExpungeLib NoDelExp StillInUse rts ExpungeLib movem.l d1-a6,-(sp) tst.w LIB_OPENCNT(a6) beq.s NoMoreUsers bset #LIBB_DELEXP,LIB_FLAGS(a6) moveq #0,d0 bra.s LeaveExpungeLib NoMoreUsers move.l a6,a5 move.l a5,a1 CallSys Remove move.l BASBASE_SEGLIST(a5),d2 move.l a5,a1 moveq #0,d0 move.w LIB_NEGSIZE(a5),d0 sub.l d0,a1 add.w LIB_POSSIZE(a5),d0 CallSys FreeMem move.l d2,d0 LeaveExpungeLib movem.l (sp)+,d1-a6 rts ExtFuncLib moveq #0,d0 rts EndCode ; ********************************************************************** ; * * ; * Strukturen * ; * * ; ********************************************************************** ; Für LINE INPUT [#] MAXLINEINPUTLEN EQU 256 ; Struktur, die zu Anfang übergeben wird STRUCTURE STARTUP,0 WORD ST_Flags ; Flaggen - derzeit unbenutzt WORD ST_Size ; Länge der Struktur WORD ST_GlobalStringsSize ; A5-Speicher WORD ST_GlobalVarsSize ; A5-Speicher WORD ST_GlobalConstStringsSize ; A5-Speicher LONG ST_ConstStringsPointer ; Anfang der konstanten Strings LONG ST_DataPointer ; Anfang der DATA-Offsets (zu A5) WORD ST_NumData ; Anzahl der DATA-Elemente LONG ST_StringsMemSize ; Größe des Speichers für Strings LONG ST_StackMemSize ; Stack für GOSUB/CALL LONG ST_EndPrg ; CloseLibrary-Routine-Zeiger für Ende LONG ST_StartPrg ; Start des Programmes LABEL STARTUP_SIZEOF ; Struktur für ein Feld STRUCTURE FIELD,0 LONG FIELD_NEXT ; Zeiger auf nächstes Feld (für Speicherreservierung) LONG FIELD_TEXTPRED ; Zeiger auf vorheriges Textfeld LONG FIELD_TEXTSUCC ; Zeiger auf nächstes Textfeld LONG FIELD_MEM ; Zeiger auf reservierten Speicher LONG FIELD_MEMSIZE ; Größe des Speichers WORD FIELD_NUMDIMS ; Anzahl der Dimensionen LABEL FIELD_FIRSTDIM ; Ab hier werden die Größen der Dimensionen abgelegt FIELD_MINSIZE EQU FIELD_NUMDIMS ; Struktur für ein geöffnetes File BUFFERSIZE EQU 4096 STRUCTURE FILE,0 LONG FL_NEXT ; Muß das 1. Element sein WORD FL_NUMBER WORD FL_ACCESSMODE LONG FL_FILELENGTH LONG FL_BUFFEROFFSET LONG FL_BUFFERNUMBYTES LONG FL_FILEPOS LONG FL_FILEHANDLE STRUCT FL_BUFFER,BUFFERSIZE LABEL FL_SIZEOF IOACCESS_INPUT EQU 1 IOACCESS_OUTPUT EQU 2 IOACCESS_READWRITE EQU 3 ; Struktur für ein Fenster STRUCTURE FENSTER,0 LONG FENSTER_NEXT LONG FENSTER_WINDOW LONG FENSTER_CONSOLEWRITE WORD FENSTER_NUMBER LONG FENSTER_TITLE LABEL FENSTER_SIZEOF Window_MinWidth EQU 100 Window_MinHeight EQU 50 ; Der Stack wächst von unten nach oben. ; Bei STACK_GOSUB ist unter dem Typ nur die Rückkehradresse abgespeichert ; Bei STACK_SUB liegt über der SUBSTACK Struktur die Variablentabelle der ; numerischen und TEXT-Variablen, darüber liegt in einem Langwort ; die Größe des benutzten Speichers ; Bei STACK_CALL ist unter dem Typ nur die Rückkehradresse abgespeichert ; ; Stackablage-Typen: STACK_GOSUB EQU 1 STACK_SUB EQU 2 STACK_CALL EQU 3 STRUCTURE SUBSTACK,0 LONG SUBSTACK_OLDFIRSTLOCALFIELD LONG SUBSTACK_OLDA4 STRUCT SUBSTACK_TEXTFIELD,FIELD_MINSIZE LABEL SUBSTACK_VARTAB ; Anzahl der Stellen von single/double-real-Variablen IEEEDP_NumNumbers EQU 14 SP_NumNumbers EQU 7 ; Alle Variable MAXTEMP EQU 20 ; Höchstanzahl an temporären Strings MAXRAWKEYS EQU 20 ; Soviele Zeichen werden zwischengespeichert MAXCONSOLECHARS EQU 10 ; So lang kann ein ANSI-String höchsten sein STRUCTURE VARS,0 STRUCT TempField,FIELD_MINSIZE ; Hieran werden alle Stringfelder gehängt STRUCT TempMem,MAXTEMP*4 WORD TempNumber STRUCT RawKeyBuffer,4*MAXRAWKEYS WORD FirstRawKey WORD LastRawKey WORD NumRawKeys STRUCT InputEvent,ie_SIZEOF STRUCT ConsoleBuffer,MAXCONSOLECHARS STRUCT GlobalStringsField,FIELD_MINSIZE ; SHARED-Stringsfeld (für GCollection) WORD GlobalStringsSize WORD GlobalVarsSize WORD GlobalConstStringsSize LONG StackMem LONG StackMemSize LONG StackPointer LONG A5Mem LONG A5MemSize LONG MemListPointer LONG FensterListPointer LONG FileListPointer ; Zeiger auf erste File-Struktur LONG StartPrg LONG EndPrg ; Hierhin muß bei einem Abbruch gesprungen ; werden LONG StringsMemSize ; Länge des String-Speichers LONG StringsMem ; Adresse des String-Speichers LONG FreeStringPointer ; Zeigt auf den nächsten freien Platz für ; Strings (auf Longword vor Länge) LONG ThisIoError ; Nummer des IO-Error oder Null wenn keiner LONG ThisSourceLine ; Um auch nach dem Compilieren die Nummer ; der Zeile festellten zu können, in der ; ein Fehler aufgetreten ist LONG _ConsoleDevice ; Library-Base-Pointer LONG _DOSBase LONG _IntuitionBase LONG _GfxBase LONG _MathBase LONG _MathTransBase LONG _MathIeeeDoubBasBase LONG _MathIeeeDoubTransBase LONG CurrentMsg ; Zwischenspeicher für Messages LABEL MousePositions ; Mauspostitions-Variable WORD NowX WORD NowY WORD DownX WORD DownY WORD UpX WORD UpY WORD PressedTimes WORD StatNow ; 0 = nicht gedrückt LONG Seconds ; Für TIMER und DATE$ Funktionen LONG Micros LONG ArgLength ; CLI-Parameter LONG ArgPointer LONG OldSP ; Sicherung des StackPointers LONG BasBase LONG FileInfoBlock BYTE InitOk ; wurde INIT__ vollständig abgearbeitet? BYTE DoEndImm ; Darf Programm sofort abgebrochen werden? ; (0 = Ja) BYTE StopAtNextOccasion ; Bei nächster Gelegenheit anhalten BYTE ErrorOccured ; Ist schon ein Fehler aufgetreten? LONG OutputFenster ; aktuelles Ausgabefenster WORD NextData ; Nummer des nächsten zu lesenden Dataelementes WORD NumData ; Anzahl aller Dataelemente LONG DataPointer ; Zeiger auf erstes Dataelement STRUCT NewWindowStruct,nw_SIZE LONG WBMessage LONG FirstLocalField ; Liste der lokalen Felder LONG FirstGlobalField ; Liste der globalen Felder STRUCT IntuiText,it_SIZEOF STRUCT ErrorLongBuffer,20 ; für Zeilennummer LONG TrapSeven ; für TRAPV STRUCT DecMantisse,20 ; für STR_R_T, STR_D_T STRUCT VALVar,8 LABEL PosSize ; ********************************************************************** ; * * ; * Strings * ; * * ; ********************************************************************** BASICText MACRO \1 dc.l *+4 dc.w \@Length \@Start EQU * dc.b \2 \@Length EQU *-\@Start dc.b 0 even ENDM BASICText DeleteLeftText,<8," ",8> BASICText TabText,<9> BASICText RetText,<10> BASICText ClsText,<12> BASICText QMarkText,<'?'> BASICText FilesText,<"Directory of: "> BASICText CursorOffText,<$9b,'0 p'> BASICText CursorOnText,<$9b,' p'> BASICText DefaultWindowText,<'Cursor V1.0 (c) 1990 Jürgen Forster'> LeerString dc.l *+4,0 ;BASICText LeerString,<> DOSName dc.b 'dos.library',0 IntuitionName dc.b 'intuition.library',0 GfxName dc.b 'graphics.library',0 MathName dc.b 'mathffp.library',0 MathTransName dc.b 'mathtrans.library',0 MathIeeeDoubBasName dc.b 'mathieeedoubbas.library',0 MathIeeeDoubTransName dc.b 'mathieeedoubtrans.library',0 ConsoleName dc.b 'console.device',0 even NullWord dc.w 0 ; ********************************************************************** ; * * ; * Macros * ; * * ; ********************************************************************** Break_On MACRO bsr TestForBreak ENDM Break_Off MACRO addq.b #1,DoEndImm(a5) ENDM IEEEDPFieee MACRO ; CallMathIeeeDoubTrans IEEEDPFieee ; diese Funktion der IEEEDoubBas-Library hat einen Fehler moveq #0,d1 move.l d0,a0 swap d0 beq.s \@ReturnZero move.w d0,d1 and.l #$7f80,d0 ; Hier steht in der IEEEDoubBas-Library and.i! asr.w #3,d0 add.w #$3800,d0 and.w #$8000,d1 or.w d1,d0 swap d0 move.l a0,d1 ror.l #3,d1 move.l d1,a0 and.l #$fffff,d1 or.l d1,d0 move.l a0,d1 and.l #$e0000000,d1 \@ReturnZero ENDM ; ********************************************************************** ; * * ; * diverse Unterroutinen * ; * * ; ********************************************************************** TestStackMem move.l d1,-(sp) move.l StackMem(a5),d1 add.l StackMemSize(a5),d1 sub.l StackPointer(a5),d1 cmp.l d1,d0 bgt ErrorStackOverflow move.l (sp)+,d1 rts ; Zeiger auf Feld in a0 AddTextField movem.l a1/a2,-(sp) lea TempField(a5),a1 move.l a1,FIELD_TEXTPRED(a0) move.l FIELD_TEXTSUCC(a1),a2 move.l a2,FIELD_TEXTSUCC(a0) move.l a0,FIELD_TEXTSUCC(a1) cmp.l #0,a2 beq.s ThereIsNoSuccessor move.l a0,FIELD_TEXTPRED(a2) ThereIsNoSuccessor movem.l (sp)+,a1/a2 rts ; Zeiger auf 1. Feld in a0 FreeFieldList move.l a2,-(sp) move.l a0,a2 FreeFieldListLoop cmp.l #0,a2 beq.s FreeFieldListReady tst.l FIELD_MEM(a2) beq.s NoFieldMemAllocated move.l FIELD_MEM(a2),a1 bsr MyFreeMem NoFieldMemAllocated clr.l FIELD_MEM(a2) clr.l FIELD_MEMSIZE(a2) tst.l FIELD_TEXTPRED(a2) beq.s NotInFieldList move.l FIELD_TEXTPRED(a2),a0 move.l FIELD_TEXTSUCC(a2),FIELD_TEXTSUCC(a0) tst.l FIELD_TEXTSUCC(a2) beq.s NoSuccesor move.l FIELD_TEXTSUCC(a2),a0 move.l FIELD_TEXTPRED(a2),FIELD_TEXTPRED(a0) NoSuccesor NotInFieldList move.l FIELD_NEXT(a2),a2 bra.s FreeFieldListLoop FreeFieldListReady move.l (sp)+,a2 rts ; Zeiger auf Fenster ist in A0 OpenConsole movem.l d1-a5,-(sp) move.l a0,d7 moveq #0,d0 move.l d0,a0 bsr _CreatePort tst.l d0 beq.s NoPort move.l d0,a2 move.l a2,a0 bsr _CreateStdIO tst.l d0 beq.s NoIO move.l d0,a3 move.l d7,IO_DATA(a3) move.l #wd_Size,IO_LENGTH(a3) lea ConsoleName,a0 moveq #0,d0 move.l a3,a1 moveq #0,d1 CallSys OpenDevice tst.l d0 bne NoConsole move.l a3,d0 movem.l (sp)+,d1-a5 rts NoConsole move.l a3,a0 bsr _DeleteStdIO NoIO move.l a2,a0 bsr _DeletePort NoPort moveq #0,d0 movem.l (sp)+,d1-a5 rts ; IoStruktur in A0 CloseConsole movem.l d0/d1/a0/a1/a2,-(sp) move.l a0,a2 move.l a2,a1 CallSys CloseDevice move.l MN_REPLYPORT(a2),a0 bsr _DeletePort move.l a2,a0 bsr _DeleteStdIO movem.l (sp)+,d0/d1/a0/a1/a2 rts ; Für die Exec-Routine RawDoFmt RawDoFmtProc move.b d0,(a3)+ rts ; >- d0: Divident, d1: Divisor ; -> d0: Rest, d1: Ergebnis ULONGDiv movem.l d2/d3,-(sp) moveq #0,d3 moveq #31,d2 DivLoop lsl.l #1,d0 roxl.l #1,d3 cmp.l d1,d3 blt.s NoSub sub.l d1,d3 addq.w #1,d0 NoSub dbra d2,DivLoop move.l d3,d1 movem.l (sp)+,d2/d3 rts CursorOn pea CursorOnText bsr PRINT_T_ rts CursorOff pea CursorOffText bsr PRINT_T_ rts ; ********************************************************************** ; * * ; * Speicherreservierung * ; * * ; ********************************************************************** ; MyAllocMem verändert nur das Register D0, MyFreeMem gar keine ; d0/d1 wie bei AllocMem MyAllocMem movem.l d1/a0/a1,-(sp) addq.l #8,d0 move.l d0,-(sp) CallSys AllocMem tst.l d0 beq ErrorOutOfMemory move.l d0,a0 move.l MemListPointer(a5),(a0) move.l d0,MemListPointer(a5) addq.l #8,d0 move.l (sp)+,4(a0) movem.l (sp)+,d1/a0/a1 rts MyFreeAllMem move.l MemListPointer(a5),a2 FreeAllLoop cmp.l #0,a2 beq.s NoMoreMem move.l a2,a1 move.l 4(a2),d0 move.l (a2),a2 ; Nächsten Zeiger vor FreeMem holen CallSys FreeMem bra.s FreeAllLoop NoMoreMem rts ; Zeiger auf Mem-Block in a1 MyFreeMem movem.l d0/d1/a0/a1,-(sp) subq.l #8,a1 lea MemListPointer(a5),a0 FreeMemLoop tst (a0) beq ErrorFreeMem cmp.l (a0),a1 beq.s FoundMemBlock move.l (a0),a0 bra.s FreeMemLoop FoundMemBlock move.l (a1),(a0) move.l 4(a1),d0 CallSys FreeMem movem.l (sp)+,d0/d1/a0/a1 rts ; ********************************************************************** ; * * ; * Zeicheneingaben vom Fenster behandeln * ; * * ; ********************************************************************** ; Ist d0 = 0, so wird nicht gewartet, in d0 wird das erhaltene Zeichen ; zurückgegeben, ist d0 gleich -1.l, so wurde kein Zeichen gelesen GetOneChar Break_Off movem.l d1-a6,-(sp) move.l d0,d7 GetOneCharLoop tst.w NumRawKeys(a5) bne.s HaveRawKey tst.l d7 beq.s GotNoChar moveq #1,d1 CallDOS Delay bra.s GetOneCharLoop GotNoChar moveq #-1,d0 movem.l (sp)+,d1-a6 Break_On rts HaveRawKey move.b #IECLASS_RAWKEY,InputEvent+ie_Class(a5) move.w FirstRawKey(a5),d0 lsl.w #2,d0 move.w RawKeyBuffer(a5,d0.w),InputEvent+ie_Code(a5) move.w RawKeyBuffer+2(a5,d0.w),InputEvent+ie_Qualifier(a5) move.w FirstRawKey(a5),d0 addq.w #1,d0 cmp.w #MAXRAWKEYS,d0 bne.s NotAtEndOfRawKeys moveq #0,d0 NotAtEndOfRawKeys move.w d0,FirstRawKey(a5) subq.w #1,NumRawKeys(a5) lea InputEvent(a5),a0 lea ConsoleBuffer(a5),a1 moveq #MAXCONSOLECHARS,d1 sub.l a2,a2 CallConsole RawKeyConvert tst.l d0 ble GetOneCharLoop cmp.l #1,d0 beq.s ReturnOneChar lea ConvertTable(pc),a0 tst.b (a0) beq.s GetOneCharLoop ConvertLoop move.l d0,d1 lea ConsoleBuffer(a5),a1 bra.s EnterCompareLoop CompareLoop tst.b (a0) beq.s NotThisString cmp.b (a0)+,(a1)+ bne.s NotThisString EnterCompareLoop dbra d1,CompareLoop tst.b (a0)+ bne.s NotThisString moveq #0,d0 move.b (a0)+,d0 bra.s ReturnD0Char NotThisString tst.b (a0)+ bne.s NotThisString addq.l #1,a0 bra.s ConvertLoop ReturnOneChar moveq #0,d0 move.b ConsoleBuffer(a5),d0 ReturnD0Char movem.l (sp)+,d1-a6 Break_On rts ConvertTable dc.b $9b,'Z',0,9 ; SHIFT+TAB (von Amiga-Basic nicht beachtet) dc.b $9b,'A',0,28 ; CSRUP dc.b $9b,'T',0,28 dc.b $9b,'B',0,29 ; DOWN dc.b $9b,'S',0,29 dc.b $9b,'C',0,30 ; RIGHT dc.b $9b,' @',0,30 dc.b $9b,'D',0,31 ; LEFT dc.b $9b,' A',0,31 dc.b $9b,'?~',0,139 ; HELP dc.b $9b,'0~',0,129 ; F1 dc.b $9b,'10~',0,129 dc.b $9b,'1~',0,130 ; F2 dc.b $9b,'11~',0,130 dc.b $9b,'2~',0,131 ; F3 dc.b $9b,'12~',0,131 dc.b $9b,'3~',0,132 ; F4 dc.b $9b,'13~',0,132 dc.b $9b,'4~',0,133 ; F5 dc.b $9b,'14~',0,133 dc.b $9b,'5~',0,134 ; F6 dc.b $9b,'15~',0,134 dc.b $9b,'6~',0,135 ; F7 dc.b $9b,'16~',0,135 dc.b $9b,'7~',0,136 ; F8 dc.b $9b,'17~',0,136 dc.b $9b,'8~',0,137 ; F9 dc.b $9b,'18~',0,137 dc.b $9b,'9~',0,138 ; F10 dc.b $9b,'19~',0,138 dc.b 0 ; Ende even ; ********************************************************************** ; * * ; * Exception/Trap behandeln * ; * * ; ********************************************************************** ExceptionCode movem.l d0-a6,-(sp) move.l 4,a5 move.l ThisTask(a5),a5 move.l TC_Userdata(a5),a5 move.l BasBase(a5),a6 bsr.s HandleMessages movem.l (sp)+,d0-a6 rts HandleMessages lea FensterListPointer(a5),a3 HandleMessagesFensterLoop tst.l FENSTER_NEXT(a3) beq.s NoMoreHandleMessagesFensters move.l FENSTER_NEXT(a3),a3 TryNextMessage move.l FENSTER_WINDOW(a3),a0 move.l wd_UserPort(a0),a0 CallSys GetMsg tst.l d0 beq.s NoMessageHere move.l d0,a2 bsr.s HandleMessage move.l a2,a1 CallSys ReplyMsg bra.s TryNextMessage NoMessageHere bra.s HandleMessagesFensterLoop NoMoreHandleMessagesFensters rts ; Message in a2 ; Fenster in a3 HandleMessage cmp.l #CLOSEWINDOW,im_Class(a2) beq Message_CLOSEWINDOW cmp.l #RAWKEY,im_Class(a2) beq Message_RAWKEY rts Message_CLOSEWINDOW tst.b DoEndImm(a5) beq.s DoEnd move.b #1,StopAtNextOccasion(a5) bra.s NotAtOnce DoEnd move.l a2,a1 CallSys ReplyMsg bra END___NoCheck NotAtOnce rts Message_RAWKEY move.w im_Code(a2),d0 tst.b d0 bmi.s KeyUpAgain cmp.w #MAXRAWKEYS,NumRawKeys(a5) beq.s DontAddRawKey move.w LastRawKey(a5),d0 lsl.w #2,d0 move.w im_Code(a2),RawKeyBuffer(a5,d0.w) move.w im_Qualifier(a2),RawKeyBuffer+2(a5,d0.w) move.w LastRawKey(a5),d0 addq.w #1,d0 cmp.w #MAXRAWKEYS,d0 bne.s NotRawEndReached moveq #0,d0 NotRawEndReached move.w d0,LastRawKey(a5) addq.w #1,NumRawKeys(a5) KeyUpAgain rts DontAddRawKey bra BEEP__ TestForBreak subq.b #1,DoEndImm(a5) bne.s NotLastBreakOff tst.b StopAtNextOccasion(a5) beq.s WasNoBreak bra END___NoCheck WasNoBreak NotLastBreakOff rts TrapCode addq.l #4,sp lea ErrorOverflow,a0 move.l a0,2(sp) rte ; ********************************************************************** ; * * ; * Öffnet alles (bricht Programm bei Fehler ab) * ; * * ; ********************************************************************** INIT__ ; Zeiger auf Startup-Struktur wird in A2 übergeben und sofort ausgewertet ; In d3 ist ggf. ein Zeiger auf die Workbench-Message ; In d4/d5 sind die vorherigen D0/A0 ; A5 ganz zu Anfang aufbauen moveq #0,d0 move.w ST_GlobalStringsSize(a2),d0 add.w ST_GlobalVarsSize(a2),d0 add.w ST_GlobalConstStringsSize(a2),d0 move.l d0,d7 add.l #PosSize,d0 move.l d0,d6 move.l #MEMF_CLEAR,d1 CallSys AllocMem tst.l d0 bne.s HaveA5Mem addq.l #4,sp move.l ST_EndPrg(a2),a0 moveq #0,d7 jmp (a0) HaveA5Mem move.l d0,a5 add.l d7,a5 move.l d0,A5Mem(a5) move.l d6,A5MemSize(a5) move.w ST_GlobalStringsSize(a2),GlobalStringsSize(a5) move.w ST_GlobalVarsSize(a2),GlobalVarsSize(a5) move.w ST_GlobalConstStringsSize(a2),GlobalConstStringsSize(a5) move.l ST_EndPrg(a2),EndPrg(a5) lea 4(sp),a0 move.l a0,OldSP(a5) move.l a6,BasBase(a5) move.l ST_StartPrg(a2),StartPrg(a5) addq.l #4,sp ; Workbench-Message merken move.l d3,WBMessage(a5) ; ; Libs öffnen ; move.l 4,a0 lea DeviceList(a0),a0 lea ConsoleName(pc),a1 CallSys FindName move.l d0,_ConsoleDevice(a5) beq END___NoCheck lea DOSName,a1 CallSys OldOpenLibrary move.l d0,_DOSBase(a5) beq END___NoCheck lea IntuitionName,a1 CallSys OldOpenLibrary move.l d0,_IntuitionBase(a5) beq END___NoCheck lea GfxName,a1 CallSys OldOpenLibrary move.l d0,_GfxBase(a5) beq END___NoCheck lea MathName,a1 CallSys OldOpenLibrary move.l d0,_MathBase(a5) beq ErrorNoMathLibrary lea MathTransName,a1 CallSys OldOpenLibrary move.l d0,_MathTransBase(a5) beq ErrorNoMathTransLibrary lea MathIeeeDoubBasName,a1 CallSys OldOpenLibrary move.l d0,_MathIeeeDoubBasBase(a5) beq ErrorNoMathIeeeDoubBasLibrary lea MathIeeeDoubTransName,a1 CallSys OldOpenLibrary move.l d0,_MathIeeeDoubTransBase(a5) beq ErrorNoMathIeeeDoubTransLibrary ; Baut die Zeiger auf die konstanten Strings auf move.l ST_ConstStringsPointer(a2),a0 move.l A5Mem(a5),a1 ; Anfang der ConstStrings move.w ST_GlobalConstStringsSize(a2),d0 lsr.w #2,d0 bra.s EnterBuildConstStringsLoop BuildConstStringsLoop move.l a0,(a1)+ move.w (a0),d1 addq.w #4,d1 bclr #0,d1 add.w d1,a0 EnterBuildConstStringsLoop dbra d0,BuildConstStringsLoop move.l ST_DataPointer(a2),DataPointer(a5) move.w ST_NumData(a2),NumData(a5) move.l ST_StringsMemSize(a2),d0 move.l d0,StringsMemSize(a5) moveq #0,d1 bsr MyAllocMem move.l d0,StringsMem(a5) move.l ST_StackMemSize(a2),d0 move.l d0,StackMemSize(a5) moveq #0,d1 bsr MyAllocMem move.l d0,StackMem(a5) move.l d0,StackPointer(a5) ; Diese müßen noch behandelt werden DEBUG move.l d4,d0 move.l d5,a0 ; ; Speicher holen ; move.l #fib_SIZEOF,d0 moveq #0,d1 bsr MyAllocMem move.l d0,FileInfoBlock(a5) ; ; Stringsvariable initialisieren ; move.l StringsMem(a5),FreeStringPointer(a5) move.l a5,a1 move.l a5,a0 sub.w GlobalStringsSize(a5),a0 bsr ClearTextField ; Tempstrings lea TempMem(a5),a0 lea MAXTEMP*4(a0),a1 bsr ClearTextField lea TempField(a5),a0 lea TempMem(a5),a1 move.l a1,FIELD_MEM(a0) move.l #MAXTEMP*4,FIELD_MEMSIZE(a0) ; SHARED-Strings move.l a5,a0 sub.w GlobalStringsSize(a5),a0 move.l a5,a1 bsr ClearTextField lea GlobalStringsField(a5),a0 moveq #0,d0 move.w GlobalStringsSize(a5),d0 move.l d0,FIELD_MEMSIZE(a0) neg.l d0 add.l a5,d0 move.l d0,FIELD_MEM(a0) bsr AddTextField moveq #7,d0 CallSys AllocTrap move.l d0,TrapSeven(a5) bmi ErrorNoTrapSeven move.b #-1,InitOk(a5) move.l 4,a0 move.l ThisTask(a0),a0 lea ExceptionCode,a1 move.l a1,TC_EXCEPTCODE(a0) move.l a5,TC_Userdata(a0) lea TrapCode,a1 move.l a1,TC_TRAPCODE(a0) move.w #1,-(sp) ; Kennung pea DefaultWindowText ; Titel clr.w -(sp) ; x1 clr.w -(sp) ; y1 move.w #639,-(sp) ; x2 move.w #199,-(sp) ; y2 move.w #%01111,-(sp) ; Typ move.w #1,-(sp) ; Schirm bsr WINDOW_ITIIIIII_ move.l StartPrg(a5),-(sp) rts ClearTextField move.l a2,-(sp) lea NullWord(pc),a2 bra.s CompThem ContClearing move.l a2,(a0)+ CompThem cmp.l a1,a0 bne.s ContClearing move.l (sp)+,a2 rts ; ********************************************************************** ; * * ; * Beendet das Programm * ; * * ; ********************************************************************** END__ addq.l #4,sp cmp.l OldSP(a5),sp bne ErrorStackTrashed END___NoCheck Break_Off move.l OldSP(a5),sp ; ; Nur ausführen, wenn INIT__ erfolgreich war ; tst.b InitOk(a5) beq.s InitFailed CloseFenstersLoop move.l FensterListPointer(a5),d0 beq.s NoMoreFensters move.l d0,a0 move.w FENSTER_NUMBER(a0),-(sp) bsr WINDOWCLOSE_I_ bra.s CloseFenstersLoop NoMoreFensters bsr CLOSE__ move.b #1,DoEndImm(a5) ; Sign setzen -> Programm wird schon beendet move.l 4,a0 move.l ThisTask(a0),a0 clr.l TC_EXCEPTCODE(a0) clr.b StopAtNextOccasion(a5) InitFailed ; ; Das wird bei jedem END__ abgearbeitet ; move.l TrapSeven(a5),d0 bmi.s NoTrapSeven CallSys FreeTrap NoTrapSeven tst.l _MathIeeeDoubTransBase(a5) beq.s NoMathIeeeDoubTransBase move.l _MathIeeeDoubTransBase(a5),a1 CallSys CloseLibrary NoMathIeeeDoubTransBase tst.l _MathIeeeDoubBasBase(a5) beq.s NoMathIeeeDoubBasBase move.l _MathIeeeDoubBasBase(a5),a1 CallSys CloseLibrary NoMathIeeeDoubBasBase tst.l _MathTransBase(a5) beq.s NoMathTransBase move.l _MathTransBase(a5),a1 CallSys CloseLibrary NoMathTransBase tst.l _MathBase(a5) beq.s NoMathBase move.l _MathBase(a5),a1 CallSys CloseLibrary NoMathBase tst.l _GfxBase(a5) beq.s NoGfxBase move.l _GfxBase(a5),a1 CallSys CloseLibrary NoGfxBase tst.l _IntuitionBase(a5) beq.s NoIntuitionBase move.l _IntuitionBase(a5),a1 CallSys CloseLibrary NoIntuitionBase tst.l _DOSBase(a5) beq.s NoDOSBase move.l _DOSBase(a5),a1 CallSys CloseLibrary NoDOSBase bsr MyFreeAllMem ; ; A5-Speicher freigeben und zurückspringen ; ; Workbench-Message zurückgeben move.l WBMessage(a5),d3 move.l EndPrg(a5),a2 move.l A5Mem(a5),a1 move.l A5MemSize(a5),d0 CallSys FreeMem moveq #0,d7 jmp (a2) ; ********************************************************************** ; * * ; * Konvertierungen * ; * * ; ********************************************************************** CONVERT_D_I movem.l (sp)+,d0/d1/d2 move.l d0,-(sp) movem.l d1/d2,-(sp) bsr CONVERT_D_L bsr CONVERT_L_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) CONVERT_D_L move.l (sp)+,a2 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPFix bvs ErrorOverflow move.l d0,-(sp) jmp (a2) CONVERT_D_R move.l (sp)+,a2 movem.l (sp)+,d0/d1 CallMathIeeeDoubTrans IEEEDPTieee bvs ErrorOverflow CallMathTrans SPFieee bvs ErrorOverflow move.l d0,-(sp) jmp (a2) CONVERT_I_D move.l (sp)+,a2 move.w (sp)+,d0 ext.l d0 move.l d0,-(sp) move.l a2,-(sp) bra CONVERT_L_D CONVERT_I_L move.l (sp)+,a2 move.w (sp)+,d0 ext.l d0 move.l d0,-(sp) jmp (a2) CONVERT_I_R move.l (sp)+,a2 move.w (sp)+,d0 ext.l d0 move.l d0,-(sp) move.l a2,-(sp) bra CONVERT_L_R CONVERT_L_D move.l (sp)+,a2 move.l (sp)+,d0 CallMathIeeeDoubBas IEEEDPFlt movem.l d0/d1,-(sp) jmp (a2) CONVERT_L_I movem.l (sp)+,a2/a3 move.l a3,d0 ext.l d0 cmp.l a3,d0 bne ErrorOverflow move.w d0,-(sp) jmp (a2) CONVERT_L_R move.l 4(sp),d0 CallMath SPFlt move.l d0,4(sp) rts CONVERT_R_D move.l (sp)+,a2 move.l (sp)+,d0 CallMathTrans SPTieee IEEEDPFieee movem.l d0/d1,-(sp) jmp (a2) CONVERT_R_I movem.l (sp)+,d0/d1 move.l d0,-(sp) move.l d1,-(sp) bsr CONVERT_R_L bsr CONVERT_L_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) CONVERT_R_L move.l (sp)+,a2 move.l (sp)+,d0 CallMath SPFix bvs ErrorOverflow move.l d0,-(sp) jmp (a2) ; ********************************************************************** ; * * ; * Arithmetische Funktionen, zuerst Vergleiche * ; * * ; ********************************************************************** EQ_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp seq d0 ext.w d0 move.w d0,-(sp) jmp (a2) EQ_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 seq d0 ext.w d0 move.w d0,-(sp) jmp (a2) EQ_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 seq d0 ext.w d0 move.w d0,-(sp) jmp (a2) EQ_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp seq d0 ext.w d0 move.w d0,-(sp) jmp (a2) NE_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp sne d0 ext.w d0 move.w d0,-(sp) jmp (a2) NE_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 sne d0 ext.w d0 move.w d0,-(sp) jmp (a2) NE_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 sne d0 ext.w d0 move.w d0,-(sp) jmp (a2) NE_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp sne d0 ext.w d0 move.w d0,-(sp) jmp (a2) GT_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp sgt d0 ext.w d0 move.w d0,-(sp) jmp (a2) GT_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 sgt d0 ext.w d0 move.w d0,-(sp) jmp (a2) GT_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 sgt d0 ext.w d0 move.w d0,-(sp) jmp (a2) GT_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp sgt d0 ext.w d0 move.w d0,-(sp) jmp (a2) LT_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp slt d0 ext.w d0 move.w d0,-(sp) jmp (a2) LT_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 slt d0 ext.w d0 move.w d0,-(sp) jmp (a2) LT_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 slt d0 ext.w d0 move.w d0,-(sp) jmp (a2) LT_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp slt d0 ext.w d0 move.w d0,-(sp) jmp (a2) GE_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp sge d0 ext.w d0 move.w d0,-(sp) jmp (a2) GE_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 sge d0 ext.w d0 move.w d0,-(sp) jmp (a2) GE_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 sge d0 ext.w d0 move.w d0,-(sp) jmp (a2) GE_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp sge d0 ext.w d0 move.w d0,-(sp) jmp (a2) LE_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPCmp sle d0 ext.w d0 move.w d0,-(sp) jmp (a2) LE_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 cmp.w d1,d0 sle d0 ext.w d0 move.w d0,-(sp) jmp (a2) LE_LL_I move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 cmp.l d0,d1 sle d0 ext.w d0 move.w d0,-(sp) jmp (a2) LE_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPCmp sle d0 ext.w d0 move.w d0,-(sp) jmp (a2) ABS_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPAbs movem.l d0/d1,4(sp) rts ABS_I_I move.w 4(sp),d0 bpl.s ABS_I_I_Ok neg.w d0 bvs ErrorOverflow move.w d0,4(sp) ABS_I_I_Ok rts ABS_L_L move.l 4(sp),d0 bpl.s ABS_L_L_Ok neg.l d0 bvs ErrorOverflow move.l d0,4(sp) ABS_L_L_Ok rts ABS_R_R move.l 4(sp),d0 CallMath SPAbs move.l d0,4(sp) rts ADD_DD_D move.l (sp)+,a2 movem.l (sp)+,d0/d1/d2/d3 CallMathIeeeDoubBas IEEEDPAdd bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) ADD_II_I move.l (sp)+,a2 move.w (sp)+,d0 add.w d0,(sp) bvs ErrorOverflow jmp (a2) ADD_LL_L move.l (sp)+,a2 move.l (sp)+,d0 add.l d0,(sp) bvs ErrorOverflow jmp (a2) ADD_RR_R move.l (sp)+,a2 movem.l (sp)+,d0/d1 CallMath SPAdd bvs ErrorOverflow move.l d0,-(sp) jmp (a2) AND_II_I move.l (sp)+,a2 move.w (sp)+,d0 and.w d0,(sp) jmp (a2) AND_LL_L move.l (sp)+,a2 move.l (sp)+,d0 and.l d0,(sp) jmp (a2) ATN_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPAtan movem.l d0/d1,4(sp) rts ATN_R_R move.l 4(sp),d0 CallMathTrans SPAtan move.l d0,4(sp) rts COS_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPCos bvs ErrorIllegalFunctionCall movem.l d0/d1,4(sp) rts COS_R_R move.l 4(sp),d0 CallMathTrans SPCos bvs ErrorIllegalFunctionCall move.l d0,4(sp) rts DIV_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPDiv bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) DIV_II_I move.l (sp)+,a2 move.w (sp)+,d1 beq ErrorDivisionByZero move.w (sp)+,d0 ext.l d0 divs d1,d0 bvs ErrorOverflow move.w d0,-(sp) jmp (a2) DIV_LL_L move.l (sp)+,a2 moveq #1,d7 move.l (sp)+,d1 beq ErrorDivisionByZero bpl.s DIV_LL_L_DivisorPos neg.l d1 ; Overflow stört nicht moveq #-1,d7 DIV_LL_L_DivisorPos move.l (sp)+,d0 bpl.s DIV_LL_L_DividendPos neg.l d0 neg.l d7 DIV_LL_L_DividendPos bsr ULONGDiv tst.l d7 bpl.s DIV_LL_L_NoMakeNeg neg.l d0 bvs ErrorOverflow DIV_LL_L_NoMakeNeg move.l d0,-(sp) jmp (a2) DIV_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPDiv bvs ErrorOverflow move.l d0,-(sp) jmp (a2) EQV_II_I move.l (sp)+,a2 move.w (sp)+,d1 move.w (sp)+,d0 eor.w d1,d0 not.w d0 move.w d0,-(sp) jmp (a2) EQV_LL_L move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 eor.l d1,d0 not.l d0 move.l d0,-(sp) jmp (a2) EXP_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPExp bvs ErrorOverflow movem.l d0/d1,4(sp) rts EXP_R_R move.l 4(sp),d0 CallMathTrans SPExp bvs ErrorOverflow move.l d0,4(sp) rts FIX_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPTst bmi.s FIX_D_D_IsNeg movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPFloor bra.s FIX_D_D_IsPos FIX_D_D_IsNeg movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPCeil FIX_D_D_IsPos movem.l d0/d1,4(sp) rts FIX_R_R move.l 4(sp),d1 CallMath SPTst bmi.s FIX_R_R_IsNeg move.l 4(sp),d0 CallMath SPFloor bra.s FIX_R_R_IsPos FIX_R_R_IsNeg move.l 4(sp),d0 CallMath SPCeil FIX_R_R_IsPos move.l d0,-(sp) rts IMP_II_I move.l (sp)+,a2 move.w (sp)+,d0 not.w d0 and.w (sp)+,d0 not.w d0 move.w d0,-(sp) jmp (a2) IMP_LL_L move.l (sp)+,a2 move.l (sp)+,d0 not.l d0 and.l (sp)+,d0 not.l d0 move.l d0,-(sp) jmp (a2) INT_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPFloor movem.l d0/d1,4(sp) rts INT_R_R move.l 4(sp),d0 CallMath SPFloor move.l d0,4(sp) rts LOG_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPLog bvs ErrorIllegalFunctionCall movem.l d0/d1,4(sp) rts LOG_R_R move.l 4(sp),d0 CallMathTrans SPLog bvs ErrorIllegalFunctionCall move.l d0,4(sp) rts MOD_II_I move.l (sp)+,a2 move.w (sp)+,d1 beq ErrorDivisionByZero move.w (sp)+,d0 ext.l d0 divs d1,d0 bvs ErrorOverflow swap d0 move.w d0,-(sp) jmp (a2) MOD_LL_L move.l (sp)+,a2 move.l (sp)+,d1 beq ErrorDivisionByZero bpl.s MOD_LL_L_DivisorPos neg.l d1 ; Overflow stört nicht MOD_LL_L_DivisorPos moveq #1,d7 move.l (sp)+,d0 bpl.s MOD_LL_L_DividendPos neg.l d0 moveq #-1,d7 MOD_LL_L_DividendPos bsr ULONGDiv tst.l d7 bpl.s MOD_LL_L_NoMakeNeg neg.l d1 bvs ErrorOverflow MOD_LL_L_NoMakeNeg move.l d1,-(sp) jmp (a2) MUL_DD_D move.l (sp)+,a2 movem.l (sp)+,d0/d1/d2/d3 CallMathIeeeDoubBas IEEEDPMul bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) MUL_II_L move.l (sp)+,a2 movem.w (sp)+,d0/d1 muls d1,d0 move.l d0,-(sp) jmp (a2) MUL_LL_L move.l (sp)+,a2 moveq #1,d4 move.l (sp)+,d0 bpl.s MUL_LL_L_D0Pos moveq #-1,d4 MUL_LL_L_D0Pos move.l (sp)+,d1 bpl.s MUL_LL_L_D1Pos neg.l d4 MUL_LL_L_D1Pos moveq #0,d2 moveq #31,d3 MUL_LL_L_Loop lsl.l #1,d2 bcs ErrorOverflow lsl.l #1,d0 bcc.s MUL_LL_L_CNotSet add.l d1,d2 bvs ErrorOverflow MUL_LL_L_CNotSet dbra d3,MUL_LL_L_Loop tst.l d2 bmi ErrorOverflow tst.l d4 bpl.s MUL_LL_L_IsPos neg.l d2 MUL_LL_L_IsPos move.l d2,-(sp) jmp (a2) MUL_RR_R move.l (sp)+,a2 movem.l (sp)+,d0/d1 CallMath SPMul bvs ErrorOverflow move.l d0,-(sp) jmp (a2) NEG_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubBas IEEEDPNeg movem.l d0/d1,4(sp) rts NEG_I_I move.w 4(sp),d0 neg.w d0 bvs ErrorOverflow move.w d0,4(sp) rts NEG_L_L move.l 4(sp),d0 neg.l d0 bvs ErrorOverflow move.l d0,4(sp) rts NEG_R_R move.l 4(sp),d0 CallMath SPNeg move.l d0,4(sp) rts NOT_I_I move.w 4(sp),d0 not.w d0 move.w d0,4(sp) rts NOT_L_L move.l 4(sp),d0 not.l d0 move.l d0,4(sp) rts OR_II_I move.l (sp)+,a2 move.w (sp)+,d0 or.w d0,(sp) jmp (a2) OR_LL_L move.l (sp)+,a2 move.l (sp)+,d0 or.l d0,(sp) jmp (a2) POT_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubTrans IEEEDPPow bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) POT_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMathTrans SPPow bvs ErrorOverflow move.l d0,-(sp) jmp (a2) SGN_D_I move.l (sp)+,a2 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPTst move.w d0,-(sp) jmp (a2) SGN_I_I move.l (sp)+,a2 move.w (sp)+,d0 SGN_I_I_SetFlag bmi.s SGN_I_I_IsNeg beq.s SGN_I_I_IsZero move.w #1,-(sp) jmp (a2) SGN_I_I_IsNeg move.w #-1,-(sp) jmp (a2) SGN_I_I_IsZero clr.w -(sp) jmp (a2) SGN_L_I move.l (sp)+,a2 move.l (sp)+,d0 bra SGN_I_I_SetFlag SGN_R_I move.l (sp)+,a2 move.l (sp)+,d1 CallMath SPTst move.w d0,-(sp) jmp (a2) SIN_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPSin bvs ErrorIllegalFunctionCall movem.l d0/d1,4(sp) rts SIN_R_R move.l 4(sp),d0 CallMathTrans SPSin bvs ErrorIllegalFunctionCall move.l d0,4(sp) rts SQR_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPSqrt bvs ErrorIllegalFunctionCall movem.l d0/d1,4(sp) rts SQR_L_I move.l (sp)+,a2 move.l (sp)+,d0 bmi ErrorIllegalFunctionCall moveq #0,d1 moveq #15,d2 moveq #0,d3 SQR_L_I_Loop lsl.l #1,d0 roxl.l #1,d1 lsl.l #1,d0 roxl.l #1,d1 lsl.l #2,d3 addq.w #1,d3 cmp.l d1,d3 bgt.s SQR_L_I_DoZero sub.l d3,d1 addq.w #2,d3 SQR_L_I_DoZero lsr.l #1,d3 dbra d2,SQR_L_I_Loop move.w d3,-(sp) jmp (a2) SQR_R_R move.l 4(sp),d0 CallMathTrans SPSqrt bvs ErrorIllegalFunctionCall move.l d0,4(sp) rts SUB_DD_D move.l (sp)+,a2 movem.l (sp)+,d2/d3 movem.l (sp)+,d0/d1 CallMathIeeeDoubBas IEEEDPSub bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) SUB_II_I move.l (sp)+,a2 move.w (sp)+,d0 sub.w d0,(sp) bvs ErrorOverflow jmp (a2) SUB_LL_L move.l (sp)+,a2 move.l (sp)+,d0 sub.l d0,(sp) bvs ErrorOverflow jmp (a2) SUB_RR_R move.l (sp)+,a2 move.l (sp)+,d1 move.l (sp)+,d0 CallMath SPSub bvs ErrorOverflow move.l d0,-(sp) jmp (a2) TAN_D_D movem.l 4(sp),d0/d1 CallMathIeeeDoubTrans IEEEDPTan bvs ErrorIllegalFunctionCall movem.l d0/d1,4(sp) rts TAN_R_R move.l 4(sp),d0 CallMathTrans SPTan bvs ErrorIllegalFunctionCall move.l d0,4(sp) rts XOR_II_I move.l (sp)+,a2 move.w (sp)+,d0 eor.w d0,(sp) jmp (a2) XOR_LL_L move.l (sp)+,a2 move.l (sp)+,d0 eor.l d0,(sp) jmp (a2) ; ********************************************************************** ; * * ; * BASIC-Funktionen * ; * * ; ********************************************************************** COLLISION_I_I bra ErrorAdvancedFeature CSRLIN__I move.l (sp)+,a2 Break_Off move.w #1,-(sp) tst.l OutputFenster(a5) beq.s CSRLIN__I_NoFenster move.l OutputFenster(a5),a0 move.l FENSTER_CONSOLEWRITE(a0),a0 move.l IO_UNIT(a0),a0 move.w cu_YCCP(a0),(sp) addq.w #1,(sp) CSRLIN__I_NoFenster Break_On jmp (a2) DATE__T bra ErrorAdvancedFeature ERL__I bra ErrorAdvancedFeature ERR__I bra ErrorAdvancedFeature FRE_I_L bra ErrorAdvancedFeature IF_IDD_D move.l (sp)+,a2 movem.l (sp)+,d0/d1/d2/d3 tst.w (sp)+ beq IF_IDD_D_False movem.l d2/d3,-(sp) jmp (a2) IF_IDD_D_False movem.l d0/d1,-(sp) jmp (a2) IF_III_I move.l (sp)+,a2 movem.w (sp)+,d0/d1 tst.w (sp)+ beq.s IF_III_I_False move.w d1,-(sp) jmp (a2) IF_III_I_False move.w d0,-(sp) jmp (a2) IF_ILL_L movem.l (sp)+,a0/a1/a2 tst.w (sp)+ beq.s IF_ILL_L_False move.l a2,-(sp) jmp (a0) IF_ILL_L_False move.l a1,-(sp) jmp (a0) IF_IRR_R EQU IF_ILL_L IF_ITT_T EQU IF_ILL_L INKEY__T move.l (sp)+,a2 moveq #0,d0 bsr GetOneChar tst.l d0 bmi.s InkeyReturnEmptyString move.w #1,a3 bsr CreateString move.l a3,-(sp) move.l (a3),a0 move.w #1,(a0)+ move.b d0,(a0) bsr FinishString jmp (a2) InkeyReturnEmptyString pea LeerString jmp (a2) LOC_I_L bra ErrorAdvancedFeature LPOS_I_I bra ErrorAdvancedFeature MENU_I_I bra ErrorAdvancedFeature MOUSE_I_I bra ErrorAdvancedFeature OBJECT.VX_I_I bra ErrorAdvancedFeature OBJECT.VY_I_I bra ErrorAdvancedFeature PEEKL_L_L movem.l (sp)+,a0/a1 move.l a1,d0 btst #0,d0 bne ErrorIllegalFunctionCall move.l (a1),-(sp) jmp (a0) PEEKW_L_I movem.l (sp)+,a0/a1 move.l a1,d0 btst #0,d0 bne ErrorIllegalFunctionCall move.w (a1),-(sp) jmp (a0) PEEK_L_I movem.l (sp)+,a0/a1 move.b (a1),d0 ext.w d0 move.w d0,-(sp) jmp (a0) POS_I_I Break_Off move.w #1,4(sp) tst.l OutputFenster(a5) beq.s POS_I_I_NoFenster move.l OutputFenster(a5),a0 move.l FENSTER_CONSOLEWRITE(a0),a0 move.l IO_UNIT(a0),a0 move.w cu_XCCP(a0),4(sp) addq.w #1,4(sp) POS_I_I_NoFenster Break_On rts RND_I_R bra ErrorAdvancedFeature RND__R bra ErrorAdvancedFeature STICK_I_I bra ErrorAdvancedFeature STRIG_I_I bra ErrorAdvancedFeature TIMER__L Break_Off lea Seconds(a5),a0 lea Micros(a5),a1 CallIntuition CurrentTime move.l Seconds(a5),d0 move.l #24*60*60,d1 bsr ULONGDiv move.l (sp)+,a2 move.l d1,-(sp) Break_On jmp (a2) TIME__T bra ErrorAdvancedFeature WINDOW_I_L bra ErrorAdvancedFeature ; ********************************************************************** ; * * ; * Einfache Funktionen zur Unterstützung der BASIC-Anweisungen/Funkt. * ; * * ; ********************************************************************** DOUBLE_D_DD move.l (sp)+,a2 movem.l (sp),d0/d1 movem.l d0/d1,-(sp) jmp (a2) DOUBLE_I_II move.l (sp)+,a2 move.w (sp),-(sp) jmp (a2) DOUBLE_L_LL move.l (sp)+,a2 move.l (sp),-(sp) jmp (a2) DOUBLE_R_RR EQU DOUBLE_L_LL DOUBLE_T_TT EQU DOUBLE_L_LL FORGET_D_ move.l (sp)+,a2 addq.l #8,sp jmp (a2) FORGET_I_ move.l (sp)+,a2 addq.l #2,sp jmp (a2) FORGET_L_ move.l (sp)+,a2 addq.l #4,sp jmp (a2) FORGET_R_ EQU FORGET_L_ FORGET_T_ EQU FORGET_L_ ; ********************************************************************** ; * * ; * Alle BASIC-Befehle * ; * * ; ********************************************************************** AREAFILL_I_ bra ErrorAdvancedFeature AREAFILL__ bra ErrorAdvancedFeature AREA_II_ bra ErrorAdvancedFeature BEEP__ Break_Off sub.l a0,a0 CallIntuition DisplayBeep Break_On rts BREAKOFF__ bra ErrorAdvancedFeature BREAKON__ bra ErrorAdvancedFeature BREAKSTOP__ bra ErrorAdvancedFeature CALL_Z_ moveq #6,d0 bsr TestStackMem move.l StackPointer(a5),a3 move.l (sp)+,(a3)+ move.w #STACK_CALL,(a3)+ move.l a3,StackPointer(a5) rts CHECKINPUTEND__ bra ErrorAdvancedFeature CIRCLE_IIIIRRR_ bra ErrorAdvancedFeature CIRCLE_IIIIRR_ bra ErrorAdvancedFeature CIRCLE_IIII_ bra ErrorAdvancedFeature CIRCLE_III_ bra ErrorAdvancedFeature CLEAR__ bra ErrorAdvancedFeature CLS__ Break_Off tst.l OutputFenster(a5) beq.s CLS___NoFenster moveq #0,d0 move.l OutputFenster(a5),a1 move.l FENSTER_WINDOW(a1),a1 move.l wd_RPort(a1),a1 CallGfx SetRast move.w #1,-(sp) bsr LOCATEX_I_ move.w #1,-(sp) bsr LOCATEY_I_ CLS___NoFenster Break_On rts COLLISIONOFF__ bra ErrorAdvancedFeature COLLISIONON__ bra ErrorAdvancedFeature COLLISIONSTOP__ bra ErrorAdvancedFeature COLOR1_I_ bra ErrorAdvancedFeature COLOR2_I_ bra ErrorAdvancedFeature SUB_II_ ; Stackbereich berechnen und testen moveq #SUBSTACK_VARTAB,d0 add.w 4(sp),d0 move.l d0,d7 ; Zeiger auf Stringsvars add.l StackPointer(a5),d7 add.w 6(sp),d0 addq.l #6,d0 ; +STACK_SUB+Größe des benutzten Speichers bsr TestStackMem ; StackPointer holen und verändern move.l StackPointer(a5),a3 add.l d0,StackPointer(a5) ; ganz nach oben die Größe des Speichers move.l d0,-6(a3,d0.l) move.w #STACK_SUB,-2(a3,d0.l) ; SUBSTACK-Struktur füllen move.l FirstLocalField(a5),(a3)+ ; SUBSTACK_OLDFIRSTLOCALFIELD move.l a4,(a3)+ ; SUBSTACK_OLDA4 move.l a3,a0 clr.l (a3)+ ; FIELD_NEXT clr.l (a3)+ ; FIELD_TEXTPRED clr.l (a3)+ ; FIELD_TEXTSUCC move.l d7,(a3)+ ; FIELD_MEM clr.w (a3)+ ; FIELD_MEMSIZE move.w 6(sp),(a3)+ bsr AddTextField move.w 4(sp),d1 bra.s SUB_II__EnterClearNumVarsLoop SUB_II__ClearNumVarsLoop clr.b (a3)+ SUB_II__EnterClearNumVarsLoop dbra d1,SUB_II__ClearNumVarsLoop move.w 6(sp),d1 lsr.w #2,d1 lea NullWord(pc),a0 bra.s SUB_II__EnterClearTextVarsLoop SUB_II__ClearTextVarsLoop move.l a0,(a3)+ SUB_II__EnterClearTextVarsLoop dbra d1,SUB_II__ClearTextVarsLoop ; a4 neu setzen move.l a3,a4 ; Fertig move.l (sp)+,a2 addq.l #4,sp jmp (a2) ENDSUB__ move.l StackPointer(a5),a3 ENDSUB___SkipReturnsLoop cmp.w #STACK_SUB,-2(a3) beq.s ENDSUB___FoundStackSub subq.l #6,a3 bra.s ENDSUB___SkipReturnsLoop ENDSUB___FoundStackSub move.l -6(a3),d0 sub.l d0,a3 move.l SUBSTACK_OLDFIRSTLOCALFIELD(a3),FirstLocalField(a5) move.l SUBSTACK_OLDA4(a3),a4 lea SUBSTACK_TEXTFIELD(a3),a0 clr.l FIELD_MEM(a0) clr.l FIELD_MEMSIZE(a0) bsr FreeFieldList subq.l #2,a3 move.l -(a3),(sp) move.l a3,StackPointer(a5) rts ERASE_f_ bra ErrorAdvancedFeature ERROR_L_ bra ErrorAdvancedFeature EXITSUB__ bra ErrorAdvancedFeature FRONTCOLOR__I bra ErrorAdvancedFeature GETCOLOR0__I bra ErrorAdvancedFeature GETINPUTPART__T bra ErrorAdvancedFeature GETWINDOWSIZE__II bra ErrorAdvancedFeature GFXSTEP_II_II bra ErrorAdvancedFeature GOSUB_Z_ moveq #6,d0 bsr TestStackMem move.l StackPointer(a5),a3 move.l (sp)+,(a3)+ move.w #STACK_GOSUB,(a3)+ move.l a3,StackPointer(a5) rts GOTO_Z_ addq.l #4,sp rts IF_IZ_ movem.l (sp)+,a0/a1 tst.w (sp)+ beq.s IF_IZ__False jmp (a0) IF_IZ__False jmp (a1) INPUT__ bra ErrorAdvancedFeature LIBRARYCLOSE__ bra ErrorAdvancedFeature LIBRARY_T_ bra ErrorAdvancedFeature LINEBF_IIIII_ bra ErrorAdvancedFeature LINEB_IIIII_ bra ErrorAdvancedFeature LINEINPUT__T bsr CursorOn move.w #MAXLINEINPUTLEN,a3 bsr CreateString move.l (sp)+,a2 move.l a3,-(sp) move.l a2,-(sp) move.l (a3),a0 move.l a0,a1 clr.w (a1)+ LINEINPUT__T_Loop moveq #-1,d0 bsr GetOneChar cmp.b #13,d0 beq.s LINEINPUT__T_EndOfLineInput cmp.b #8,d0 bne.s LINEINPUT__T_NoBackSpace ; BackSpace tst.w (a0) beq.s LINEINPUT__T_Loop subq.w #1,(a0) subq.l #1,a1 movem.l a0/a1,-(sp) pea DeleteLeftText bsr PRINT_T_ movem.l (sp)+,a0/a1 bra.s LINEINPUT__T_Loop LINEINPUT__T_NoBackSpace move.b d0,d1 and.b #$7f,d1 ; SteuerCode? cmp.b #$20,d1 blt.s LINEINPUT__T_Loop move.w (a0),d1 cmp.w #MAXLINEINPUTLEN,d1 bhi.s LINEINPUT__T_Loop move.b d0,(a1)+ addq.w #1,(a0) movem.l a0/a1,-(sp) lsl.w #8,d0 move.w d0,-(sp) move.w #1,-(sp) move.l sp,-(sp) move.l sp,-(sp) bsr PRINT_T_ addq.l #8,sp movem.l (sp)+,a0/a1 bra LINEINPUT__T_Loop LINEINPUT__T_EndOfLineInput bsr FinishString bsr CursorOff bra PRINTRETURN__ LINE_IIIII_ bra ErrorAdvancedFeature LOCATEX_I_ bsr CSRLIN__I move.w (sp)+,d1 move.l (sp)+,a2 move.w d1,-(sp) move.l a2,-(sp) bra LOCATEXY_II_ LOCATEY_I_ clr.w -(sp) bsr POS_I_I move.w (sp)+,d0 move.l (sp)+,a2 move.w (sp)+,d1 move.w d0,-(sp) move.w d1,-(sp) move.l a2,-(sp) bra LOCATEXY_II_ LOCATEXY_II_ move.l FreeStringPointer(a5),a3 move.l a3,a1 move.l (sp)+,a2 move.l (sp)+,(a3)+ move.l a2,-(sp) addq.l #4,a3 move.l a3,-4(a3) pea -4(a3) addq.l #2,a3 lea LOCATEY_I_FormatString,a0 lea RawDoFmtProc,a2 CallSys RawDoFmt move.l (sp),a0 move.l (a0),a0 move.l a0,a1 move.w #-1,(a1)+ LOCATEY_I_Loop addq.w #1,(a0) tst.b (a1)+ bne.s LOCATEY_I_Loop bsr PRINT_T_ rts LOCATEY_I_FormatString dc.b $9b,"%d;%dH",0 even LPRINTRETURN__ bra ErrorAdvancedFeature LPRINTTAB__ bra ErrorAdvancedFeature LPRINT_D_ bra ErrorAdvancedFeature LPRINT_I_ bra ErrorAdvancedFeature LPRINT_L_ bra ErrorAdvancedFeature LPRINT_R_ bra ErrorAdvancedFeature LPRINT_T_ bra ErrorAdvancedFeature MENUOFF__ bra ErrorAdvancedFeature MENUON__ bra ErrorAdvancedFeature MENURESET__ bra ErrorAdvancedFeature MENUSTOP__ bra ErrorAdvancedFeature MENU_IIIT_ bra ErrorAdvancedFeature MENU_III_ bra ErrorAdvancedFeature MOUSEOFF__ bra ErrorAdvancedFeature MOUSEON__ bra ErrorAdvancedFeature MOUSESTOP__ bra ErrorAdvancedFeature NEXT_DDDZ_ movem.l (sp)+,a2/a3 movem.l (sp)+,d0/d1/d2/d3/d4/d5 CallMathIeeeDoubBas IEEEDPTst beq.s NEXT_DDDZ_DoLoop bmi.s NEXT_DDDZ_IsNeg move.l d4,d0 move.l d5,d1 CallMathIeeeDoubBas IEEEDPCmp bgt.s NEXT_DDDZ_LeaveLoop jmp (a3) NEXT_DDDZ_IsNeg move.l d4,d0 move.l d5,d1 CallMathIeeeDoubBas IEEEDPCmp bge.s NEXT_DDDZ_DoLoop NEXT_DDDZ_LeaveLoop jmp (a2) NEXT_DDDZ_DoLoop jmp (a3) NEXT_IIIZ_ movem.l (sp)+,a2/a3 movem.w (sp)+,d0/d1/d2 tst.w d0 beq.s NEXT_IIIZ_DoLoop bmi.s NEXT_IIIZ_IsNeg cmp.w d1,d2 bgt.s NEXT_IIIZ_LeaveLoop jmp (a3) NEXT_IIIZ_IsNeg cmp.w d1,d2 bge.s NEXT_IIIZ_DoLoop NEXT_IIIZ_LeaveLoop jmp (a2) NEXT_IIIZ_DoLoop jmp (a3) NEXT_LLLZ_ movem.l (sp)+,a2/a3 movem.l (sp)+,d0/d1/d2 tst.l d0 beq.s NEXT_LLLZ_DoLoop bmi.s NEXT_LLLZ_IsNeg cmp.l d1,d2 bgt.s NEXT_LLLZ_LeaveLoop jmp (a3) NEXT_LLLZ_IsNeg cmp.l d1,d2 bge.s NEXT_LLLZ_DoLoop NEXT_LLLZ_LeaveLoop jmp (a2) NEXT_LLLZ_DoLoop jmp (a3) NEXT_RRRZ_ movem.l (sp)+,a2/a3 movem.l (sp)+,d1/d2/d3 CallMath SPTst beq.s NEXT_RRRZ_DoLoop bmi.s NEXT_RRRZ_IsNeg move.l d3,d0 move.l d2,d1 CallMath SPCmp bgt.s NEXT_RRRZ_LeaveLoop jmp (a3) NEXT_RRRZ_IsNeg move.l d3,d0 move.l d2,d1 CallMath SPCmp bge.s NEXT_RRRZ_DoLoop NEXT_RRRZ_LeaveLoop jmp (a2) NEXT_RRRZ_DoLoop jmp (a3) OBJECT.AX_II_ bra ErrorAdvancedFeature OBJECT.AY_II_ bra ErrorAdvancedFeature OBJECT.CLIP_IIII_ bra ErrorAdvancedFeature OBJECT.CLOSE__ bra ErrorAdvancedFeature OBJECT.CLOSE_I_ bra ErrorAdvancedFeature OBJECT.HIT1_II_I bra ErrorAdvancedFeature OBJECT.HIT2_II_I bra ErrorAdvancedFeature OBJECT.OFF_I_ bra ErrorAdvancedFeature OBJECT.OFF__ bra ErrorAdvancedFeature OBJECT.ON_I_ bra ErrorAdvancedFeature OBJECT.ON__ bra ErrorAdvancedFeature OBJECT.PLANES1_II_I bra ErrorAdvancedFeature OBJECT.PLANES2_II_I bra ErrorAdvancedFeature OBJECT.PRIORITY_II_ bra ErrorAdvancedFeature OBJECT.SHAPE_II_ bra ErrorAdvancedFeature OBJECT.SHAPE_IT_ bra ErrorAdvancedFeature OBJECT.START__ bra ErrorAdvancedFeature OBJECT.START_I_ bra ErrorAdvancedFeature OBJECT.STOP__ bra ErrorAdvancedFeature OBJECT.STOP_I_ bra ErrorAdvancedFeature OBJECT.VX_II_ bra ErrorAdvancedFeature OBJECT.VY_II_ bra ErrorAdvancedFeature OBJECT.X_II_ bra ErrorAdvancedFeature OBJECT.Y_II_ bra ErrorAdvancedFeature ONBREAKGOSUB_Z_ bra ErrorAdvancedFeature ONCOLLISIONGOSUB_Z_ bra ErrorAdvancedFeature ONERRORGOTO_Z_ bra ErrorAdvancedFeature ONGOSUB_IIZ_II move.l (sp)+,a2 move.l (sp)+,a3 move.w (sp),d0 bmi ErrorIllegalFunctionCall addq.w #1,2(sp) cmp.w 2(sp),d0 beq.s ON_GOSUB_IIZ_II_DoGosub jmp (a2) ON_GOSUB_IIZ_II_DoGosub moveq #6,d0 bsr TestStackMem move.l StackPointer(a5),a0 move.l a2,(a0)+ move.w #STACK_GOSUB,(a0)+ move.l a0,StackPointer(a5) jmp (a3) ONGOTO_IIZ_II move.l (sp)+,a2 move.l (sp)+,a3 move.w (sp),d0 bmi ErrorIllegalFunctionCall addq.w #1,2(sp) cmp.w 2(sp),d0 beq.s ON_GOTO_IIZ_II_DoGoto jmp (a2) ON_GOTO_IIZ_II_DoGoto addq.l #4,sp jmp (a3) ONMENUGOSUB_Z_ bra ErrorAdvancedFeature ONMOUSEGOSUB_Z_ bra ErrorAdvancedFeature ONTIMERGOSUB_IZ_ bra ErrorAdvancedFeature PAINT_IIII_ bra ErrorAdvancedFeature PALETTE_IRRR_ bra ErrorAdvancedFeature PATTERN1_L_ bra ErrorAdvancedFeature PATTERN2_L_ bra ErrorAdvancedFeature POINT_II_I bra ErrorAdvancedFeature POKEL_LL_ move.l (sp)+,a2 move.l (sp)+,d0 move.l (sp)+,a0 move.l a0,d1 btst #0,d1 bne ErrorIllegalFunctionCall move.l d0,(a0) jmp (a2) POKEW_LI_ move.l (sp)+,a2 move.w (sp)+,d0 move.l (sp)+,a0 move.l a0,d1 btst #0,d1 bne ErrorIllegalFunctionCall move.w d0,(a0) jmp (a2) POKE_LI_ move.l (sp)+,a2 move.w (sp)+,d0 move.l (sp)+,a0 move.b d0,(a0) jmp (a2) PRESET_III_ bra ErrorAdvancedFeature PRINTQMARK__ pea QMarkText bsr PRINT_T_ rts PRINTRETURN__ pea RetText bsr PRINT_T_ rts PRINTTAB__ pea TabText bsr PRINT_T_ rts PRINT_D_ move.l (sp)+,a2 movem.l (sp)+,d0/d1 movem.l d0/d1/a2,-(sp) bsr STR_D_T bsr PRINT_T_ rts PRINT_I_ move.l (sp)+,a2 move.w (sp)+,d0 ext.l d0 move.l d0,-(sp) move.l a2,-(sp) bra PRINT_L_ PRINT_L_ move.l (sp)+,a2 move.l (sp)+,d0 move.l a2,-(sp) move.l d0,-(sp) bsr STR_L_T bsr PRINT_T_ rts PRINT_R_ move.l (sp)+,a2 move.l (sp)+,d0 move.l a2,-(sp) move.l d0,-(sp) bsr STR_R_T bsr PRINT_T_ rts PRINT_T_ move.l (sp)+,a2 Break_Off tst.l OutputFenster(a5) beq.s PRINT_T__NoFenster move.l OutputFenster(a5),a1 move.l FENSTER_CONSOLEWRITE(a1),a1 move.l (sp)+,a0 move.l (a0),a0 moveq #0,d0 move.w (a0)+,d0 move.l d0,IO_LENGTH(a1) move.l a0,IO_DATA(a1) move.w #CMD_WRITE,IO_COMMAND(a1) CallSys DoIO PRINT_T__NoFenster Break_On jmp (a2) PSET_III_ bra ErrorAdvancedFeature RANDOMIZE_I_ bra ErrorAdvancedFeature RANDOMIZE__ bra ErrorAdvancedFeature READ__T move.l (sp)+,a2 move.w NextData(a5),d0 cmp.w NumData(a5),d0 bhi ErrorOutOfData addq.w #1,NextData(a5) lsl.w #1,d0 move.l DataPointer(a5),a0 move.w 0(a0,d0.w),d0 pea 0(a5,d0.w) jmp (a2) RESTORE_I_ move.l (sp)+,a2 move.w (sp)+,NextData(a5) jmp (a2) RESTORE__ clr.w NextData(a5) rts RESUMENEXT__ bra ErrorAdvancedFeature RESUME_Z_ bra ErrorAdvancedFeature RESUME__ bra ErrorAdvancedFeature RETURN_Z_ move.l StackPointer(a5),a0 cmp.l StackMem(a5),a0 beq ErrorReturnWithoutGosub cmp.w #STACK_GOSUB,-(a0) bne ErrorReturnWithoutGosub subq.l #4,a0 move.l a0,StackPointer(a5) addq.l #4,sp rts RETURN__ move.l StackPointer(a5),a0 cmp.l StackMem(a5),a0 beq ErrorReturnWithoutGosub cmp.w #STACK_GOSUB,-(a0) bne ErrorReturnWithoutGosub move.l -(a0),(sp) move.l a0,StackPointer(a5) rts RUN_Z_ bra ErrorAdvancedFeature RUN__ bra ErrorAdvancedFeature SCREENCLOSE_I_ bra ErrorAdvancedFeature SCREEN_IIIII_ bra ErrorAdvancedFeature SCROLL_IIIIII_ bra ErrorAdvancedFeature ; So läßt sich bei einem Fehler-Abbruch die aktuelle Sourcecode-Zeile ; feststellen, allerdings muß diese Routine vom Hauptprogramm immer ; dann aufgerufen werden, wenn eine neue BASIC-Zeile Übersetzt wird. SETLINE_L_ move.l (sp)+,a2 move.l (sp)+,ThisSourceLine(a5) cmp.l OldSP(a5),sp bne ErrorStackTrashed jmp (a2) SETMEM_L_ bra ErrorAdvancedFeature SETSTACK_L_ bra ErrorAdvancedFeature SLEEP__ bra ErrorAdvancedFeature SOUNDRESUME__ bra ErrorAdvancedFeature SOUNDWAIT__ bra ErrorAdvancedFeature SOUND_IIII_ bra ErrorAdvancedFeature SWAP_dd_ movem.l (sp)+,a0/a1/a2 movem.l (a1),d0/d1 movem.l (a2),d2/d3 movem.l d2/d3,(a1) movem.l d0/d1,(a2) jmp (a0) SWAP_ii_ movem.l (sp)+,a0/a1/a2 move.w (a1),d0 move.w (a2),(a1) move.w d0,(a2) jmp (a0) SWAP_ll_ movem.l (sp)+,a0/a1/a2 move.l (a1),d0 move.l (a2),(a1) move.l d0,(a1) jmp (a0) SWAP_rr_ movem.l (sp)+,a0/a1/a2 move.l (a1),d0 move.l (a2),(a1) move.l d0,(a1) jmp (a0) SWAP_tt_ movem.l (sp)+,a0/a1/a2 move.l (a1),d0 move.l (a2),(a1) move.l d0,(a1) jmp (a0) SYSTEM__ EQU END__ TIMEROFF__ bra ErrorAdvancedFeature TIMERON__ bra ErrorAdvancedFeature TIMERSTOP__ bra ErrorAdvancedFeature TRANSLATE_T_T bra ErrorAdvancedFeature TROFF__ bra ErrorAdvancedFeature TRON__ bra ErrorAdvancedFeature WINDOWCLOSE_I_ move.l (sp)+,a2 CallSys Forbid move.w (sp)+,d0 lea FensterListPointer(a5),a3 WINDOWCLOSE_I__SearchLoop move.l a3,a0 tst.l (a0) beq ErrorIllegalFunctionCall move.l (a0),a3 cmp.w FENSTER_NUMBER(a3),d0 bne.s WINDOWCLOSE_I__SearchLoop move.l (a3),(a0) cmp.l OutputFenster(a5),a3 beq.s WINDOWCLOSE_I__NotTheOutputFenster clr.l OutputFenster(a5) WINDOWCLOSE_I__NotTheOutputFenster move.l FENSTER_CONSOLEWRITE(a3),a0 bsr CloseConsole move.l FENSTER_WINDOW(a3),a0 CallIntuition CloseWindow move.l FENSTER_TITLE(a3),a1 bsr MyFreeMem move.l a3,a1 bsr MyFreeMem CallSys Permit jmp (a2) WINDOWOUTPUT_I_ bra ErrorAdvancedFeature WINDOW_ITIIIIII_ Break_Off ; Speicher für Fensterstruktur reservieren moveq #FENSTER_SIZEOF,d0 moveq #0,d1 bsr MyAllocMem move.l d0,a3 ; Werte vom Stack lesen und auswerten lea NewWindowStruct(a5),a0 ; Rückkehradresse move.l (sp)+,a2 ; Screen addq.l #2,sp ; überlesen DEBUG move.w #WBENCHSCREEN,nw_Type(a0) clr.l nw_Screen(a0) ; Typ move.w (sp)+,d0 move.l #ACTIVATE|GIMMEZEROZERO,d1 btst #0,d0 beq.s NoWindowSizing or.l #WINDOWSIZING|SIZEBRIGHT,d1 NoWindowSizing btst #1,d0 beq.s NoWindowDrag or.l #WINDOWDRAG,d1 NoWindowDrag btst #2,d0 beq.s NoWindowDepth or.l #WINDOWDEPTH,d1 NoWindowDepth btst #3,d0 beq.s NoWindowClose or.l #WINDOWCLOSE,d1 NoWindowClose btst #4,d0 beq.s NoSuperBitMap or.l #SUPER_BITMAP,d1 NoSuperBitMap move.l d1,nw_Flags(a0) move.l #CLOSEWINDOW|MOUSEBUTTONS|RAWKEY,nw_IDCMPFlags(a0) ; Koordinaten move.w (sp)+,d3 move.w (sp)+,d2 move.w (sp)+,d1 move.w (sp)+,d0 sub.w d0,d2 addq.w #1,d2 cmp.w #Window_MinWidth,d2 blt ErrorIllegalFunctionCall sub.w d1,d3 addq.w #1,d3 cmp.w #Window_MinHeight,d3 blt ErrorIllegalFunctionCall move.w d0,nw_LeftEdge(a0) move.w d1,nw_TopEdge(a0) move.w d2,nw_Width(a0) move.w d3,nw_Height(a0) ; Pens move.b #-1,nw_DetailPen(a0) move.b #-1,nw_BlockPen(a0) ; FirstGadget ist immer Null ; CheckMark ist immer Null move.l (sp)+,a1 move.l (a1),a1 moveq #0,d0 move.w (a1),d0 addq.w #1,d0 moveq #0,d1 bsr MyAllocMem move.l d0,FENSTER_TITLE(a3) move.l d0,nw_Title(a0) move.l a0,-(sp) move.l d0,a0 move.w (a1)+,d0 WindowTitleLoop move.b (a1)+,(a0)+ dbra d0,WindowTitleLoop move.l (sp)+,a0 ; Bitmap clr.l nw_BitMap(a0) move.w #Window_MinWidth,nw_MinWidth(a0) move.w #Window_MinHeight,nw_MinHeight(a0) move.w #-1,nw_MaxWidth(a0) move.w #-1,nw_MaxHeight(a0) move.w (sp)+,FENSTER_NUMBER(a3) ; Das Fenster wirklich öffnen CallIntuition OpenWindow move.l d0,FENSTER_WINDOW(a3) beq ErrorCannotOpenWindow move.l d0,a0 bsr OpenConsole tst.l d0 beq GotNoConsole move.l d0,FENSTER_CONSOLEWRITE(a3) move.l a3,OutputFenster(a5) move.l FensterListPointer(a5),FENSTER_NEXT(a3) move.l a3,FensterListPointer(a5) ; Exception-Flag setzen move.l FENSTER_WINDOW(a3),a0 move.l wd_UserPort(a0),a0 move.b MP_SIGBIT(a0),d2 moveq #0,d0 bset d2,d0 move.l d0,d1 CallSys SetExcept Break_On move.l a2,-(sp) bra CursorOff GotNoConsole move.l FENSTER_WINDOW(a3),a0 CallIntuition CloseWindow bra ErrorCouldNotOpenConsole ; ********************************************************************** ; * * ; * Stringfunktionen * ; * * ; ********************************************************************** ADD_TT_T move.l (sp)+,a2 move.l (sp)+,a1 move.l (sp)+,a0 move.l (a0),a0 move.l (a1),a1 move.w (a0)+,d0 move.w (a1)+,d1 move.w d0,d2 add.w d1,d2 move.w d2,a3 bsr CreateString move.l a3,-(sp) move.l a2,-(sp) move.l (a3),a3 move.w d2,(a3)+ bsr.s ADD_TT_T_EnterLoop move.l a1,a0 move.w d1,d0 bsr.s ADD_TT_T_EnterLoop bra FinishString ADD_TT_T_Loop move.b (a0)+,(a3)+ ADD_TT_T_EnterLoop dbra d0,ADD_TT_T_Loop rts ASC_T_I movem.l (sp)+,a0/a1 move.l (a1),a1 tst.w (a1)+ beq ErrorIllegalFunctionCall moveq #0,d0 move.b (a1),d0 move.w d0,-(sp) jmp (a0) CHR_I_T move.w #1,a3 bsr CreateString move.l (sp)+,a0 move.w (sp)+,d0 bmi ErrorIllegalFunctionCall cmp.w #256,d0 bge ErrorIllegalFunctionCall move.l a3,-(sp) move.l (a3),a1 move.w #1,(a1)+ move.b d0,(a1) move.l a0,-(sp) bra FinishString CVD_T_D move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 cmp.w #8,(a0)+ blt ErrorIllegalFunctionCall movem.l (a0),d0/d1 movem.l d0/d1,-(sp) jmp (a2) CVI_T_I move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 cmp.w #2,(a0)+ blt ErrorIllegalFunctionCall move.w (a0),-(sp) jmp (a2) CVL_T_L move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 cmp.w #4,(a0)+ blt ErrorIllegalFunctionCall move.l (a0),-(sp) jmp (a2) CVL_T_R EQU CVL_T_L EQ_TT_I movem.l (sp)+,a0/a1/a2 move.l (a1),a1 move.l (a2),a2 move.w (a1)+,d0 cmp.w (a2)+,d0 bne.s EQ_TT_I_False bra.s EQ_TT_I_EnterLoop EQ_TT_I_Loop cmpm.b (a1)+,(a2)+ bne.s EQ_TT_I_False EQ_TT_I_EnterLoop dbra d0,EQ_TT_I_Loop move.w #-1,-(sp) jmp (a0) EQ_TT_I_False clr.w -(sp) jmp (a0) GE_TT_I moveq #3,d7 bra CompareStrings GT_TT_I moveq #1,d7 bra CompareStrings HEX_L_T move.w #8,a3 bsr CreateString move.l 4(sp),d0 move.l a3,4(sp) move.l (a3),a0 move.w #8,(a0)+ moveq #7,d1 lea HexTable,a1 moveq #0,d2 HEX_L_T_Loop rol.l #4,d0 move.b d0,d2 and.b #$f,d2 move.b 0(a1,d2.w),(a0)+ dbra d1,HEX_L_T_Loop bra FinishString HexTable dc.b "0123456789ABCDEF" even ; d0: verbleibende Versuche ; d1: Länge String2 ; d2: ggf. richtiges Ergebnis ; a0: Rest von String1 ; a1: Anfang von String2 INSTR_ITT_I move.l (sp)+,a2 move.l (sp)+,a1 move.l (a1),a1 move.l (sp)+,a0 move.l (a0),a0 move.w (sp)+,d2 ble ErrorIllegalFunctionCall move.w (a0)+,d0 beq.s INSTR_ITT_I_0 move.w (a1)+,d1 beq.s INSTR_ITT_I_1 sub.w d2,d0 sub.w d1,d0 addq.w #2,d0 bmi INSTR_ITT_I_0 lea -1(a0,d2.w),a0 bra.s INSTR_ITT_I_EnterLoop INSTR_ITT_I_Loop move.w d1,d5 move.l a0,d6 move.l a1,d7 bra.s INSTR_ITT_I_EnterCompLoop INSTR_ITT_I_CompLoop cmpm.b (a0)+,(a1)+ bne.s INSTR_ITT_I_NotFound INSTR_ITT_I_EnterCompLoop dbra d5,INSTR_ITT_I_CompLoop bra.s INSTR_ITT_I_D2 INSTR_ITT_I_NotFound move.l d6,a0 move.l d7,a1 addq.l #1,a0 addq.w #1,d2 INSTR_ITT_I_EnterLoop dbra d0,INSTR_ITT_I_Loop INSTR_ITT_I_0 clr.w -(sp) jmp (a2) INSTR_ITT_I_D2 move.w d2,-(sp) jmp (a2) INSTR_ITT_I_1 move.w #1,-(sp) jmp (a2) INSTR_TT_I movem.l (sp)+,a0/a1/a2 move.w #1,-(sp) movem.l a0/a1/a2,-(sp) bra INSTR_ITT_I LEFT_TI_T move.l (sp)+,a2 move.w (sp)+,d0 bmi ErrorIllegalFunctionCall move.w #1,-(sp) move.w d0,-(sp) move.l a2,-(sp) bra MID_TII_T LEN_T_I movem.l (sp)+,a0/a1 move.l (a1),a1 move.w (a1),-(sp) jmp (a0) LE_TT_I moveq #6,d7 bra CompareStrings LT_TT_I moveq #4,d7 bra CompareStrings MID_TII_T move.l (sp)+,a2 move.w (sp)+,d1 bmi ErrorIllegalFunctionCall move.w (sp)+,d0 ble ErrorIllegalFunctionCall move.l (sp)+,a0 move.l (a0),a0 move.w (a0)+,d2 subq.w #1,d0 lea 0(a0,d0.w),a0 sub.w d0,d2 cmp.w d2,d1 ble MID_TII_T_NotTooLong move.w d2,d1 MID_TII_T_NotTooLong tst.w d1 ble MID_TII_T_ReturnEmptyString move.w d1,a3 bsr CreateString move.l a3,-(sp) move.l (a3),a1 move.w d1,(a1)+ bra.s MID_TII_T_EnterLoop MID_TII_T_Loop move.b (a0)+,(a1)+ MID_TII_T_EnterLoop dbra d1,MID_TII_T_Loop bsr FinishString jmp (a2) MID_TII_T_ReturnEmptyString pea LeerString jmp (a2) MID_TI_T move.l (sp)+,a2 move.w #$7fff,-(sp) move.l a2,-(sp) bra MID_TII_T MKD_D_T move.w #8,a3 bsr CreateString move.l (sp)+,a2 movem.l (sp)+,d0/d1 move.l a3,-(sp) move.l (a3),a0 move.w #8,(a0)+ movem.l d0/d1,(a0) bsr FinishString jmp (a2) MKI_I_T move.w #2,a3 bsr CreateString move.l (sp)+,a2 move.w (sp)+,d0 move.l a3,-(sp) move.l (a3),a0 move.w #2,(a0)+ move.w d0,(a0) bsr FinishString jmp (a2) MKL_L_T move.w #4,a3 bsr CreateString move.l (a3),a0 move.w #4,(a0)+ move.l 4(sp),(a0) move.l a3,4(sp) bra FinishString MKS_R_T EQU MKL_L_T NE_TT_I movem.l (sp)+,a0/a1/a2 move.l (a1),a1 move.l (a2),a2 move.w (a1)+,d0 cmp.w (a2)+,d0 bne.s NE_TT_I_True bra.s NE_TT_I_EnterLoop NE_TT_I_Loop cmpm.b (a1)+,(a2)+ bne.s NE_TT_I_True NE_TT_I_EnterLoop dbra d0,NE_TT_I_Loop clr.w -(sp) jmp (a0) NE_TT_I_True move.w #-1,-(sp) jmp (a0) OCT_L_T bra ErrorAdvancedFeature RIGHT_TI_T move.l (sp)+,a2 move.w (sp)+,d0 bmi ErrorIllegalFunctionCall move.l (sp),a0 move.l (a0),a0 cmp.w (a0),d0 ble.s RIGHT_TI_T_NoCutString move.w (a0),d0 RIGHT_TI_T_NoCutString move.w (a0),d1 sub.w d0,d1 addq.w #1,d1 move.w d1,-(sp) move.w d0,-(sp) move.l a2,-(sp) bra MID_TII_T SADD_T_L move.l 4(sp),a0 move.l (a0),a0 addq.l #2,a0 move.l a0,4(sp) rts SETMID_tIIT_ bra ErrorAdvancedFeature SETMID_tIT_ bra ErrorAdvancedFeature SPACE_I_T move.l (sp)+,a2 move.w (sp)+,d0 move.w d0,a3 bsr CreateString move.l a3,-(sp) move.l a2,-(sp) move.l (a3),a3 move.w d0,(a3)+ bra.s SPACE_I_T_EnterLoop SPACE_I_T_Loop move.b #' ',(a3)+ SPACE_I_T_EnterLoop dbra d0,SPACE_I_T_Loop bra FinishString STRING_II_T move.l (sp)+,a2 move.w (sp)+,d0 bmi ErrorIllegalFunctionCall cmp.w #256,d0 bge ErrorIllegalFunctionCall bra Enter_STRING_IT_T STRING_IT_T move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 tst.w (a0)+ beq ErrorIllegalFunctionCall move.b (a0),d0 Enter_STRING_IT_T move.w (sp)+,d1 move.w d1,a3 bsr CreateString move.l a3,-(sp) move.l a2,-(sp) move.l (a3),a3 move.w d1,(a3)+ bra.s STRING_IT_T_EnterLoop STRING_IT_T_Loop move.b d0,(a3)+ STRING_IT_T_EnterLoop dbra d1,STRING_IT_T_Loop bra FinishString STR_D_T move.l (sp)+,a2 moveq #IEEEDP_NumNumbers,d5 ; Stellenzahl movem.l (sp)+,d6/d7 STR_D_T_EnterMe ; String zum Ablegen erzeugen move.w #100,a3 bsr CreateString move.l a3,-(sp) move.l a2,-(sp) move.l (a3),a3 move.l a3,a2 clr.w (a3)+ ; Zahl gleich Null, positiv oder negativ? move.l d6,d0 move.l d7,d1 CallMathIeeeDoubBas IEEEDPTst beq STR_D_T_ReturnZero bpl.s STR_D_T_IsPositive move.b #'-',(a3)+ move.l d6,d0 move.l d7,d1 CallMathIeeeDoubBas IEEEDPAbs move.l d0,d6 move.l d1,d7 bra.s STR_D_T_IsNegative STR_D_T_IsPositive move.b #' ',(a3)+ STR_D_T_IsNegative ; Zehnerexponent isolieren move.l d6,d0 move.l d7,d1 CallMathIeeeDoubTrans IEEEDPLog10 CallMathIeeeDoubBas IEEEDPFloor move.l d0,-(sp) move.l d1,-(sp) CallMathIeeeDoubBas IEEEDPFix move.l d0,d4 ; Exponent move.l #$40240000,d0 ; 10 im IEEEDP-Format moveq #0,d1 move.l (sp)+,d3 move.l (sp)+,d2 CallMathIeeeDoubTrans IEEEDPPow move.l d0,d2 move.l d1,d3 move.l d6,d0 move.l d7,d1 CallMathIeeeDoubBas IEEEDPDiv move.l d0,d6 move.l d1,d7 ; Zehnerexponent in d4 ; Stellenzahl in d5 ; Zahl in d6/d7 (Vorzeichen ist behandelt, Zahl ist ungleich 0) move.l a2,-(sp) movem.l d6/d7,VALVar(a5) move.l d5,d6 lea DecMantisse(a5),a2 clr.b (a2)+ STR_D_T_CreateNumbersLoop movem.l VALVar(a5),d0/d1 CallMathIeeeDoubBas IEEEDPFloor move.l d0,-(sp) move.l d1,-(sp) CallMathIeeeDoubBas IEEEDPFix move.b d0,(a2)+ movem.l VALVar(a5),d0/d1 move.l (sp)+,d3 move.l (sp)+,d2 CallMathIeeeDoubBas IEEEDPSub move.l #$40240000,d2 ; 10 im IEEEDP-Format moveq #0,d3 CallMathIeeeDoubBas IEEEDPMul movem.l d0/d1,VALVar(a5) dbra d6,STR_D_T_CreateNumbersLoop ; runden cmp.b #5,-(a2) blt.s STR_D_T_NoRoundUp addq.b #1,-1(a2) STR_D_T_NoRoundUp move.l d5,d6 bra.s STR_D_T_EnterRoundLoop STR_D_T_RoundLoop cmp.b #10,-(a2) blt.s STR_D_T_NotGreaterNine sub.b #10,(a2) addq.b #1,-1(a2) STR_D_T_NotGreaterNine STR_D_T_EnterRoundLoop dbra d6,STR_D_T_RoundLoop move.l (sp)+,a2 ; a0 zeigt auf erstes Zeichen der Mantisse, a1 hinter das letzte lea DecMantisse+1(a5),a0 lea 0(a0,d5),a1 tst.b -1(a0) beq.s STR_D_T_NoOverflow subq.l #1,a0 subq.l #1,a1 addq.l #1,d4 STR_D_T_NoOverflow STR_D_T_RemoveZerosLoop tst.b -1(a1) bne.s STR_D_T_NoMoreZeros subq.l #1,a1 cmp.l a0,a1 beq STR_D_T_ReturnZero bra.s STR_D_T_RemoveZerosLoop STR_D_T_NoMoreZeros ; Position des Kommas feststellen moveq #1,d6 cmp.l d5,d4 bge.s STR_D_T_DoExp move.l d5,d7 neg.l d7 cmp.l d7,d4 ble.s STR_D_T_DoExp add.l d4,d6 moveq #0,d4 STR_D_T_DoExp ; Zahl in den String schreiben tst.l d6 ; führende Nullen ausgeben bgt.s STR_D_T_NoFrontZeros move.b #'.',(a3)+ STR_D_T_FrontZerosLoop addq.l #1,d6 bgt.s STR_D_T_NoMoreFrontZeros move.b #'0',(a3)+ bra.s STR_D_T_FrontZerosLoop STR_D_T_NoMoreFrontZeros subq.l #2,d6 STR_D_T_NoFrontZeros STR_D_T_Output1Loop ; Zahlen ausgeben cmp.l a0,a1 beq.s STR_D_T_NoMoreNumbers tst.l d6 bne.s STR_D_T_NoPutPoint move.b #'.',(a3)+ STR_D_T_NoPutPoint subq.l #1,d6 move.b (a0)+,d0 add.b #'0',d0 move.b d0,(a3)+ bra.s STR_D_T_Output1Loop STR_D_T_NoMoreNumbers tst.l d6 ; Nullen am Ende ausgeben ble.s STR_D_T_Output1Finished move.b #'0',(a3)+ subq.l #1,d6 bra.s STR_D_T_NoMoreNumbers STR_D_T_Output1Finished ; Exponent ggf. ausgeben clr.b (a3) tst.l d4 beq.s STR_D_T_NoExponentOutput cmp.l #IEEEDP_NumNumbers,d5 beq.s STR_D_T_OutPutD move.b #'E',(a3)+ bra.s STR_D_T_OutPutE STR_D_T_OutPutD move.b #'D',(a3)+ STR_D_T_OutPutE tst.l d4 bmi.s STR_D_T_ExpNegative move.b #'+',(a3)+ STR_D_T_ExpNegative move.l a2,-(sp) lea STR_D_T_FormatString,a0 move.l FreeStringPointer(a5),a1 move.l d4,(a1) lea RawDoFmtProc,a2 CallSys RawDoFmt move.l (sp)+,a2 STR_D_T_NoExponentOutput ; Stringlänge berechnen move.l a2,a3 move.w #-1,(a3)+ STR_D_T_GetStringLen addq.w #1,(a2) tst.b (a3)+ bne.s STR_D_T_GetStringLen bra FinishString STR_D_T_ReturnZero move.w #' 0',(a3)+ move.w #2,(a2) bra FinishString STR_D_T_FormatString dc.b "%ld",0 even STR_I_T move.l (sp)+,a2 move.w (sp)+,d0 ext.l d0 move.l d0,-(sp) move.l a2,-(sp) bra STR_L_T STR_L_T_String dc.b " %ld",0 even STR_L_T Break_Off move.w #20,a3 bsr CreateString move.l a3,d7 lea STR_L_T_String,a0 lea 4(sp),a1 tst.l (a1) bpl.s STR_L_T_UseSpace addq.l #1,a0 STR_L_T_UseSpace lea RawDoFmtProc,a2 move.l (a3),a3 addq.l #2,a3 CallSys RawDoFmt move.l d7,4(sp) move.l d7,a0 move.l (a0),a0 move.l a0,a1 clr.w (a1)+ STR_L_T_TestStringLenght tst.b (a1)+ beq.s STR_L_T_EndOfNewStringReached addq.w #1,(a0) bra.s STR_L_T_TestStringLenght STR_L_T_EndOfNewStringReached bsr FinishString Break_On rts STR_R_T move.l (sp)+,a2 move.l (sp)+,d0 CallMathTrans SPTieee IEEEDPFieee moveq #SP_NumNumbers,d5 ; Stellenzahl move.l d0,d6 move.l d1,d7 bra STR_D_T_EnterMe UCASE_T_T move.l 4(sp),a0 move.l (a0),a0 move.w (a0)+,d0 move.w d0,a3 bsr CreateString move.l a3,4(sp) move.l (a3),a1 move.w d0,(a1)+ bra.s UCASE_T_T_EnterLoop UCASE_T_T_Loop move.b (a0)+,d1 cmp.b #'a',d1 blt.s UCASE_T_T_NotToUpper cmp.b #'z',d1 bgt.s UCASE_T_T_NotToUpper and.b #$df,d1 UCASE_T_T_NotToUpper move.b d1,(a1)+ UCASE_T_T_EnterLoop dbra d0,UCASE_T_T_Loop bra FinishString VAL_T_D move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 move.w (a0)+,d0 bsr VAL_T_D_SkipSpaces ; Vorzeichen moveq #0,d3 tst.w d0 beq.s VAL_T_D_NoMinus cmp.b #'-',(a0) bne.s VAL_T_D_NoMinus moveq #-1,d3 subq.w #1,d0 addq.l #1,a0 VAL_T_D_NoMinus ; Mantisse auslesen moveq #0,d4 ; 64 Bit Mantisse moveq #0,d5 moveq #0,d6 ; Noch keinen Dezimalpunkt gefunden moveq #0,d7 ; Zehnerexponent VAL_T_D_Pass1Loop tst.w d0 beq VAL_T_D_Pass1Finished move.b (a0)+,d1 subq.w #1,d0 cmp.b #'.',d1 beq VAL_T_D_FoundPoint cmp.b #'E',d1 beq VAL_T_D_FoundExponent cmp.b #'e',d1 beq VAL_T_D_FoundExponent cmp.b #'D',d1 beq VAL_T_D_FoundExponent cmp.b #'d',d1 beq VAL_T_D_FoundExponent cmp.b #'0',d1 blt VAL_T_D_Pass1Finished cmp.b #'9',d1 bgt VAL_T_D_Pass1Finished sub.b #'0',d1 ext.w d1 ext.l d1 ; Paßt noch etwas in die Mantisse hinein? ; $0de0b6b3a7640000 10^18 ; $8ac7230489e80000 10^19 cmp.l #$0de0b6b3,d4 bhi VAL_T_D_MantisseFull bne.s VAL_T_D_MantisseNotFull cmp.l #$a7640000,d5 bhi VAL_T_D_MantisseFull VAL_T_D_MantisseNotFull ; auf Punkt achten tst.l d6 beq.s VAL_T_D_NoPointYet subq.l #1,d7 VAL_T_D_NoPointYet ; d4/d5 verzehnfachen movem.l d6/d7,-(sp) add.l d5,d5 addx.l d4,d4 move.l d5,d7 move.l d4,d6 add.l d5,d5 addx.l d4,d4 add.l d5,d5 addx.l d4,d4 add.l d7,d5 addx.l d6,d4 movem.l (sp)+,d6/d7 ; d1 dazu add.l d1,d5 bcc.s VAL_T_D_CarryClear addq.l #1,d4 VAL_T_D_CarryClear bra VAL_T_D_Pass1Loop ; Dezimalpunkt gefunden VAL_T_D_FoundPoint not.l d6 beq VAL_T_D_Pass1Finished bra VAL_T_D_Pass1Loop ; Kein Platz mehr in der Mantisse VAL_T_D_MantisseFull tst.l d6 bne VAL_T_D_Pass1Loop addq.l #1,d7 bra VAL_T_D_Pass1Loop ; ; Exponent auswerten ; ; d2 kommt zum Zehnerexponenten noch dazu VAL_T_D_FoundExponent ; Vorzeichen des Exponenten moveq #1,d6 tst.w d0 beq.s VAL_T_D_ExponentNotPlusOrMinus cmp.b #'-',(a0) bne.s VAL_T_D_ExponentNotMinus moveq #-1,d6 subq.w #1,d0 addq.l #1,a0 bra.s VAL_T_D_ExponentWasMinus VAL_T_D_ExponentNotMinus cmp.b #'+',(a0) bne.s VAL_T_D_ExponentNotPlusOrMinus subq.w #1,d0 addq.l #1,a0 VAL_T_D_ExponentWasMinus VAL_T_D_ExponentNotPlusOrMinus ; Exponent selber auslesen moveq #0,d2 VAL_T_D_ExponentLoop subq.w #1,d0 bmi.s VAL_T_D_NoMoreExponentChars move.b (a0)+,d1 sub.b #'0',d1 bmi.s VAL_T_D_NoMoreExponentChars cmp.b #10,d1 bge.s VAL_T_D_NoMoreExponentChars move.l d1,-(sp) add.l d2,d2 move.l d2,d1 add.l d2,d2 add.l d2,d2 add.l d1,d2 add.l (sp)+,d2 cmp.l #10000,d2 bgt ErrorOverflow bra.s VAL_T_D_ExponentLoop VAL_T_D_NoMoreExponentChars muls d6,d2 add.l d2,d7 ; ; in Double-Zahl wandeln ; VAL_T_D_Pass1Finished ; Vorzeichen in d3, Mantisse in d4/d5, Zehnerexponent in d7 ; Ist das Ergebnis 0? tst.l d4 bne.s VAL_T_D_NotZero tst.l d5 beq VAL_T_D_ReturnZero VAL_T_D_NotZero ; ggf. nach rechts schieben move.l #$43300000,d0 VAL_T_D_ShiftRightLoop1 cmp.l #$003fffff,d4 bls.s VAL_T_D_LeaveShiftRightLoop1 add.l #$00100000,d0 lsr.l #1,d5 lsr.l #1,d4 bcc.s VAL_T_D_ShiftRightLoop1 bset #31,d5 bra.s VAL_T_D_ShiftRightLoop1 VAL_T_D_LeaveShiftRightLoop1 ; ggf. nach links schieben VAL_T_D_ShiftLeftLoop btst #21,d4 bne.s VAL_T_D_LeaveShiftLeftLoop sub.l #$00100000,d0 lsl.l #1,d4 lsl.l #1,d5 bcc.s VAL_T_D_ShiftLeftLoop bset #0,d4 bra.s VAL_T_D_ShiftLeftLoop VAL_T_D_LeaveShiftLeftLoop ; Aufrunden addq.l #1,d5 bcc.s VAL_T_D_NoRoundOverflow addq.l #1,d4 VAL_T_D_NoRoundOverflow ; Nochmal nach rechts schieben VAL_T_D_ShiftRightLoop2 cmp.l #$001fffff,d4 bls.s VAL_T_D_LeaveShiftRightLoop2 add.l #$00100000,d0 lsr.l #1,d5 lsr.l #1,d4 bcc.s VAL_T_D_ShiftRightLoop2 bset #31,d5 bra.s VAL_T_D_ShiftRightLoop2 VAL_T_D_LeaveShiftRightLoop2 ; fertig mit Schieben bclr #20,d4 or.l d0,d4 tst.l d3 beq.s VAL_T_D_NotNegativ bset #31,d4 VAL_T_D_NotNegativ ; Zehnerexponenten berücksichtigen move.l d7,d0 CallMathIeeeDoubBas IEEEDPFlt move.l d0,d2 move.l d1,d3 move.l #$40240000,d0 ; 10 im IEEEDP-Format moveq #0,d1 CallMathIeeeDoubTrans IEEEDPPow bvs ErrorOverflow move.l d4,d2 move.l d5,d3 CallMathIeeeDoubBas IEEEDPMul bvs ErrorOverflow movem.l d0/d1,-(sp) jmp (a2) VAL_T_D_ReturnZero clr.l -(sp) clr.l -(sp) jmp (a2) VAL_T_D_SkipSpaces tst.w d0 beq.s VAL_T_D_NoMoreSpaces cmp.b #' ',(a0) bne.s VAL_T_D_NoMoreSpaces addq.l #1,a0 subq.w #1,d0 bra.s VAL_T_D_SkipSpaces VAL_T_D_NoMoreSpaces rts ; d7: ; Bit 0: Darf String 1 größer sein? ; Bit 1: Dürfen die Strings identisch sein? ; Bit 2: Darf String 2 größer sein? CompareStrings move.l (sp)+,a2 move.l (sp)+,a1 move.l (sp)+,a0 move.l (a0),a0 move.l (a1),a1 move.w (a0)+,d0 move.w (a1)+,d1 NoDecisionMade tst.w d0 beq.s String1Empty tst.w d1 beq.s String1IsGreater subq.w #1,d0 subq.w #1,d1 cmpm.b (a0)+,(a1)+ beq.s NoDecisionMade bhi.s String2IsGreater String1IsGreater moveq #1,d0 bra.s LeaveCompareStrings String2IsGreater moveq #4,d0 bra.s LeaveCompareStrings String1Empty tst.w d1 bne.s String2IsGreater moveq #2,d0 ; Die Strings sind identisch LeaveCompareStrings and.l d7,d0 bne.s CompStringsTrue clr.w -(sp) jmp (a2) CompStringsTrue move.w #-1,-(sp) jmp (a2) ; ********************************************************************** ; * * ; * I/O-Basicanweisungen * ; * * ; ********************************************************************** CHDIR_T_ Break_Off move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 addq.l #2,a0 bsr LockIt move.l d0,d1 CallDOS CurrentDir move.l d0,d1 CallDOS UnLock Break_On jmp (a2) CLOSE__ move.l FileListPointer(a5),d0 beq.s NoMoreFiles move.l d0,a0 move.w FL_NUMBER(a0),-(sp) bsr CLOSE_I_ bra.s CLOSE__ NoMoreFiles rts CLOSE_I_ move.l (sp)+,a2 Break_Off move.w (sp)+,d0 bsr ReallyFindFileStruct ; Aus der Liste entfernen lea FileListPointer(a5),a0 CLOSE_I__Loop cmp.l FL_NEXT(a0),a3 beq.s CLOSE_I__FoundIt move.l FL_NEXT(a0),a0 bra.s CLOSE_I__Loop CLOSE_I__FoundIt move.l FL_NEXT(a3),FL_NEXT(a0) ; ggf. noch schreiben cmp.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a3) bne.s CLOSE_I__NoOutputFile move.l FL_BUFFERNUMBYTES(a3),d3 beq.s CLOSE_I__BufferEmpty lea FL_BUFFER(a3),a0 move.l a0,d2 move.l FL_FILEHANDLE(a3),d1 CallDOS Write tst.b ErrorOccured(a5) bne.s CLOSE_I__DontCareForError tst.l d0 bmi ErrorIO CLOSE_I__DontCareForError CLOSE_I__BufferEmpty CLOSE_I__NoOutputFile ; File schließen move.l FL_FILEHANDLE(a3),d1 CallDOS Close ; Speicher freigeben move.l a3,a1 bsr MyFreeMem ; fertig Break_On jmp (a2) EOF_I_I move.w 4(sp),d0 bsr ReallyFindFileStruct cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a3) bne ErrorBadFileMode move.l FL_FILEPOS(a3),d0 sub.l FL_BUFFERNUMBYTES(a3),d0 cmp.l FL_FILELENGTH(a3),d0 seq d0 ext.w d0 move.w d0,4(sp) rts FILEINPUT_I_IT bra ErrorAdvancedFeature FILELINEINPUT_I_T Break_Off move.l (sp)+,d7 move.w (sp)+,d0 bsr ReallyFindFileStruct cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a3) bne ErrorBadFileMode move.l FL_FILEPOS(a3),d0 sub.l FL_BUFFERNUMBYTES(a3),d0 cmp.l FL_FILELENGTH(a3),d0 beq ErrorInputPastEnd move.l a3,d6 move.w #MAXLINEINPUTLEN,a3 bsr CreateString move.l a3,-(sp) move.l (a3),a0 move.l a0,a1 clr.w (a1)+ move.l d6,a3 move.l d7,-(sp) FILELINEINPUT_I_T_AddToString lea FL_BUFFER(a3),a2 add.l FL_BUFFEROFFSET(a3),a2 move.l FL_BUFFERNUMBYTES(a3),d0 bra.s FILELINEINPUT_I_T_EnterLoop FILELINEINPUT_I_T_Loop move.b (a2)+,d1 addq.l #1,FL_BUFFEROFFSET(a3) subq.l #1,FL_BUFFERNUMBYTES(a3) cmp.b #10,d1 beq.s FILELINEINPUT_I_T_ReachedEnd cmp.w #MAXLINEINPUTLEN,(a0) beq ErrorStringTooLong move.b d1,(a1)+ addq.w #1,(a0) FILELINEINPUT_I_T_EnterLoop dbra d0,FILELINEINPUT_I_T_Loop move.l FL_FILELENGTH(a3),d0 sub.l FL_FILEPOS(a3),d0 ble.s FILELINEINPUT_I_T_ReachedEnd cmp.l #BUFFERSIZE,d0 ble.s FILELINEINPUT_I_T_D0Ok move.l #BUFFERSIZE,d0 FILELINEINPUT_I_T_D0Ok clr.l FL_BUFFEROFFSET(a3) move.l d0,FL_BUFFERNUMBYTES(a3) add.l d0,FL_FILEPOS(a3) move.l FL_FILEHANDLE(a3),d1 pea FL_BUFFER(a3) move.l (sp)+,d2 move.l d0,d3 movem.l a0/a1,-(sp) CallDOS Read movem.l (sp)+,a0/a1 tst.l d0 bmi ErrorIO bra.s FILELINEINPUT_I_T_AddToString FILELINEINPUT_I_T_ReachedEnd Break_On bra FinishString FILEPRINTRETURN_I_I move.l (sp)+,a2 pea RetText move.l a2,-(sp) bra FILEPRINT_IT_I FILEPRINTTAB_I_I move.l (sp)+,a2 pea TabText move.l a2,-(sp) bra FILEPRINT_IT_I FILEPRINT_ID_I move.l (sp)+,a2 movem.l (sp)+,d0/d1 move.w (sp)+,d2 move.l a2,-(sp) move.w d2,-(sp) movem.l d0/d1,-(sp) bsr STR_D_T bsr FILEPRINT_IT_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) FILEPRINT_II_I move.l (sp)+,a2 move.w (sp)+,d0 move.w (sp)+,d1 move.l a2,-(sp) move.w d1,-(sp) move.w d0,-(sp) bsr STR_I_T bsr FILEPRINT_IT_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) FILEPRINT_IL_I move.l (sp)+,a2 move.l (sp)+,d0 move.w (sp)+,d1 move.l a2,-(sp) move.w d1,-(sp) move.l d0,-(sp) bsr STR_L_T bsr FILEPRINT_IT_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) FILEPRINT_IR_I move.l (sp)+,a2 move.l (sp)+,d0 move.w (sp)+,d1 move.l a2,-(sp) move.w d1,-(sp) move.l d0,-(sp) bsr STR_R_T bsr FILEPRINT_IT_I move.w (sp)+,d0 move.l (sp)+,a2 move.w d0,-(sp) jmp (a2) FILEPRINT_IT_I Break_Off move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),a0 moveq #0,d3 move.w (a0)+,d3 move.l a0,d2 move.w (sp),d0 bsr ReallyFindFileStruct cmp.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a3) bne ErrorBadFileMode add.l d3,FL_FILELENGTH(a3) add.l d3,FL_FILEPOS(a3) ; Puffer benutzen? cmp.l #BUFFERSIZE,d3 blt.s FILEPRINT_IT_I_BufferIt ; Puffer nicht benutzen, zuerst aber ausgeben tst.l FL_BUFFERNUMBYTES(a3) beq.s FILEPRINT_IT_I_BufferEmpty move.l d2,-(sp) move.l d3,-(sp) lea FL_BUFFER(a3),a0 move.l a0,d2 move.l FL_BUFFERNUMBYTES(a3),d3 clr.l FL_BUFFERNUMBYTES(a3) move.l FL_FILEHANDLE(a3),d1 CallDOS Write tst.l d0 bmi ErrorIO move.l (sp)+,d3 move.l (sp)+,d2 FILEPRINT_IT_I_BufferEmpty move.l FL_FILEHANDLE(a3),d1 CallDOS Write tst.l d0 bmi ErrorIO Break_On jmp (a2) FILEPRINT_IT_I_BufferIt FILEPRINT_IT_I_BufferLoop ; Anzahl der in den Puffer zu schreibenden Bytes bestimmen move.l #BUFFERSIZE,d4 sub.l FL_BUFFERNUMBYTES(a3),d4 bne.s FILEPRINT_IT_I_BufferNotFull move.l d2,-(sp) move.l d3,-(sp) clr.l FL_BUFFERNUMBYTES(a3) move.l #BUFFERSIZE,d3 lea FL_BUFFER(a3),a0 move.l a0,d2 move.l FL_FILEHANDLE(a3),d1 CallDOS Write tst.l d0 bmi ErrorIO move.l (sp)+,d3 move.l (sp)+,d2 bra.s FILEPRINT_IT_I_BufferLoop FILEPRINT_IT_I_BufferNotFull cmp.l d3,d4 ble.s FILEPRINT_IT_I_D4IsOk move.l d3,d4 FILEPRINT_IT_I_D4IsOk ; Zahl der noch zu schreibenden Bytes verringern, in den Puffer kopieren sub.l d4,d3 move.l d2,a0 lea FL_BUFFER(a3),a1 add.l FL_BUFFERNUMBYTES(a3),a1 add.l d4,FL_BUFFERNUMBYTES(a3) bra.s FILEPRINT_IT_I_EnterCopyLoop FILEPRINT_IT_I_CopyLoop move.b (a0)+,(a1)+ FILEPRINT_IT_I_EnterCopyLoop dbra d4,FILEPRINT_IT_I_CopyLoop move.l a0,d2 tst.l d3 bgt.s FILEPRINT_IT_I_BufferLoop Break_On jmp (a2) FILES_T_ Break_Off ; Directory of... ausgeben pea FilesText bsr PRINT_T_ ; Namen holen und untersuchen move.l (sp)+,a2 move.l (sp)+,a0 move.l a2,-(sp) move.l (a0),a0 addq.l #2,a0 bsr LockIt move.l d0,d7 ; Namen ausgeben FILES_T__NextFile move.l FreeStringPointer(a5),a0 addq.l #4,a0 move.l a0,-4(a0) move.l a0,a1 clr.w (a1)+ move.l FileInfoBlock(a5),a2 tst.l fib_DirEntryType(a2) bmi.s FILES_T__NoDir1 move.b #"[",(a1)+ addq.w #1,(a0) FILES_T__NoDir1 moveq #0,d0 FILES_T__NextChar tst.b fib_FileName(a2,d0.w) beq.s FILES_T__LastFound move.b fib_FileName(a2,d0.w),(a1)+ addq.w #1,(a0) addq.w #1,d0 cmp.w #108,d0 bne.s FILES_T__NextChar FILES_T__LastFound tst.l fib_DirEntryType(a2) bmi.s FILES_T__NoDir2 move.b #"]",(a1)+ addq.w #1,(a0) FILES_T__NoDir2 move.b #10,(a1)+ addq.w #1,(a0) move.l FreeStringPointer(a5),-(sp) bsr PRINT_T_ move.l d7,d1 move.l FileInfoBlock(a5),d2 CallDOS ExNext tst.l d0 bne.s FILES_T__NextFile ; Ist ein Fehler aufgetreten? CallDOS IoErr cmp.l #232,d0 bne.s FILES_T__Error move.l d7,d1 CallDOS UnLock Break_On rts FILES_T__Error move.l d0,ThisIoError(a5) move.l d7,d1 CallDOS UnLock bra ErrorIO FILES__ move.l (sp)+,a2 pea LeerString move.l a2,-(sp) bra FILES_T_ INPUT_II_T Break_Off move.l (sp)+,d6 move.w (sp)+,d0 bsr ReallyFindFileStruct move.l a3,a2 cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a2) bne ErrorBadFileMode moveq #0,d7 move.w (sp)+,d7 bmi ErrorIllegalFunctionCall move.l FL_FILEPOS(a2),d0 sub.l FL_BUFFERNUMBYTES(a2),d0 add.l d7,d0 cmp.l FL_FILELENGTH(a2),d0 bhi ErrorInputPastEnd move.w d7,a3 bsr CreateString move.l a3,-(sp) move.l (a3),a3 move.w d7,(a3)+ move.l d6,-(sp) INPUT_II_T_AddToString tst.w d7 beq.s INPUT_II_T_ReachedEnd lea FL_BUFFER(a2),a0 add.l FL_BUFFEROFFSET(a2),a0 move.l FL_BUFFERNUMBYTES(a2),d0 bra.s INPUT_II_T_EnterLoop INPUT_II_T_Loop move.b (a0)+,(a3)+ addq.l #1,FL_BUFFEROFFSET(a2) subq.l #1,FL_BUFFERNUMBYTES(a2) subq.w #1,d7 ble.s INPUT_II_T_ReachedEnd INPUT_II_T_EnterLoop dbra d0,INPUT_II_T_Loop move.l FL_FILELENGTH(a2),d0 sub.l FL_FILEPOS(a2),d0 cmp.l #BUFFERSIZE,d0 ble.s INPUT_II_T_D0Ok move.l #BUFFERSIZE,d0 INPUT_II_T_D0Ok clr.l FL_BUFFEROFFSET(a2) move.l d0,FL_BUFFERNUMBYTES(a2) add.l d0,FL_FILEPOS(a2) move.l FL_FILEHANDLE(a2),d1 pea FL_BUFFER(a2) move.l (sp)+,d2 move.l d0,d3 CallDOS Read tst.l d0 bmi ErrorIO bra.s INPUT_II_T_AddToString INPUT_II_T_ReachedEnd Break_On bra FinishString KILL_T_ Break_Off move.l (sp)+,a2 move.l (sp)+,a0 move.l (a0),d1 addq.l #2,d1 CallDOS DeleteFile tst.l d0 beq ErrorIO Break_On jmp (a2) LOF_I_L move.l (sp)+,a2 move.w (sp)+,d0 bsr ReallyFindFileStruct move.l FL_FILELENGTH(a3),-(sp) jmp (a2) NAME_TT_ Break_Off move.l (sp)+,a2 move.l (sp)+,a1 move.l (sp)+,a0 move.l (a0),d1 move.l (a1),d2 addq.l #2,d1 addq.l #2,d2 CallDOS Rename tst.l d0 beq ErrorIO Break_On jmp (a2) OPENAPPEND_TI_ Break_Off ; Ist das File schon geöffnet? move.w 4(sp),d0 bsr FindFileStruct cmp.l #0,a3 bne ErrorFileAlreadyOpen ; File-Struktur besorgen move.l #FL_SIZEOF,d0 moveq #0,d1 bsr MyAllocMem move.l d0,a2 ; File-Struktur initialisieren move.w 4(sp),FL_NUMBER(a2) move.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a2) clr.l FL_FILELENGTH(a2) clr.l FL_BUFFEROFFSET(a2) clr.l FL_BUFFERNUMBYTES(a2) clr.l FL_FILEPOS(a2) ; File öffnen move.l 6(sp),a0 move.l (a0),d1 addq.l #2,d1 move.l #MODE_OLDFILE,d2 CallDOS Open move.l d0,FL_FILEHANDLE(a2) beq OPENAPPEND_TI__OpenError move.l FL_FILEHANDLE(a2),d1 moveq #0,d2 moveq #OFFSET_END,d3 CallDOS Seek move.l FL_FILEHANDLE(a2),d1 moveq #0,d2 moveq #OFFSET_CURRENT,d3 CallDOS Seek move.l d0,FL_FILELENGTH(a2) ; in die File-Liste eintragen move.l FileListPointer(a5),FL_NEXT(a2) move.l a2,FileListPointer(a5) ; Fertig Break_On move.l (sp)+,a2 addq.l #6,sp jmp (a2) OPENAPPEND_TI__OpenError CallDOS IoErr move.l d0,ThisIoError(a5) bra ErrorIO OPENINPUT_TI_ Break_Off ; Ist das File schon geöffnet? move.w 4(sp),d0 bsr FindFileStruct cmp.l #0,a3 bne ErrorFileAlreadyOpen ; File-Struktur besorgen move.l #FL_SIZEOF,d0 moveq #0,d1 bsr MyAllocMem move.l d0,a2 ; File-Struktur initialisieren move.w 4(sp),FL_NUMBER(a2) move.w #IOACCESS_INPUT,FL_ACCESSMODE(a2) clr.l FL_BUFFEROFFSET(a2) clr.l FL_BUFFERNUMBYTES(a2) clr.l FL_FILEPOS(a2) ; File öffnen move.l 6(sp),a0 move.l (a0),d1 addq.l #2,d1 move.l #MODE_OLDFILE,d2 CallDOS Open move.l d0,FL_FILEHANDLE(a2) beq OPENINPUT_TI__OpenError ; File-Länge bestimmen move.l FL_FILEHANDLE(a2),d1 moveq #0,d2 moveq #OFFSET_END,d3 CallDOS Seek move.l FL_FILEHANDLE(a2),d1 moveq #0,d2 moveq #OFFSET_BEGINNING,d3 CallDOS Seek move.l d0,FL_FILELENGTH(a2) ; in die File-Liste eintragen move.l FileListPointer(a5),FL_NEXT(a2) move.l a2,FileListPointer(a5) ; Fertig Break_On move.l (sp)+,a2 addq.l #6,sp jmp (a2) OPENINPUT_TI__OpenError CallDOS IoErr move.l d0,ThisIoError(a5) bra ErrorIO OPENOUTPUT_TI_ Break_Off ; Ist das File schon geöffnet? move.w 4(sp),d0 bsr FindFileStruct cmp.l #0,a3 bne ErrorFileAlreadyOpen ; File-Struktur besorgen move.l #FL_SIZEOF,d0 moveq #0,d1 bsr MyAllocMem move.l d0,a2 ; File-Struktur initialisieren move.w 4(sp),FL_NUMBER(a2) move.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a2) clr.l FL_FILELENGTH(a2) clr.l FL_BUFFEROFFSET(a2) clr.l FL_BUFFERNUMBYTES(a2) clr.l FL_FILEPOS(a2) ; File öffnen move.l 6(sp),a0 move.l (a0),d1 addq.l #2,d1 move.l #MODE_NEWFILE,d2 CallDOS Open move.l d0,FL_FILEHANDLE(a2) beq OPENOUTPUT_TI__OpenError ; in die File-Liste eintragen move.l FileListPointer(a5),FL_NEXT(a2) move.l a2,FileListPointer(a5) ; Fertig Break_On move.l (sp)+,a2 addq.l #6,sp jmp (a2) OPENOUTPUT_TI__OpenError CallDOS IoErr move.l d0,ThisIoError(a5) bra ErrorIO OPENREADWRITE_TI_ bra ErrorAdvancedFeature ; Versucht File mit Namen in a0 (Zeiger auf Zeiger) zu "locken" und ; zu "examinen" und gibt den Lock in d0 zurück (prüft auf Directory) LockIt move.l a0,d1 moveq #ACCESS_READ,d2 CallDOS Lock move.l d0,d7 beq.s LockIt_CouldNotLockError move.l d7,d1 move.l FileInfoBlock(a5),d2 CallDOS Examine tst.l d0 beq.s LockIt_CouldNotExamineError move.l FileInfoBlock(a5),a0 tst.l fib_DirEntryType(a0) bmi.s LockIt_NoDirectoryError move.l d7,d0 rts LockIt_CouldNotLockError CallDOS IoErr move.l d0,ThisIoError(a5) bra ErrorIO LockIt_CouldNotExamineError CallDOS IoErr move.l d0,ThisIoError(a5) move.l d7,d1 CallDOS UnLock bra ErrorIO LockIt_NoDirectoryError move.l d7,d1 CallDOS UnLock bra ErrorNoDirectory ; Filestruktur mit Nummer in d0 suchen, gibt Zeiger auf Struktur in a3 zurück ; (oder 0, wenn nicht gefunden) FindFileStruct lea FileListPointer(a5),a3 LookNextFile move.l FL_NEXT(a3),a3 cmp.l #0,a3 beq.s NoSuchFile cmp.w FL_NUMBER(a3),d0 bne.s LookNextFile NoSuchFile rts ; Gleich wie FindFileStruct, nur wird abgebrochen, wenn das File nicht ; gefunden wurde ReallyFindFileStruct bsr FindFileStruct cmp.l #0,a3 beq ErrorBadFileNumber rts ; ********************************************************************** ; * * ; * Felderfunktionen * ; * * ; ********************************************************************** DIMDOUB_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #3,d7 bsr DimField move.l FirstLocalField(a5),FIELD_NEXT(a0) move.l a0,FirstLocalField(a5) jmp (a2) DIMINT_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #1,d7 bsr DimField move.l FirstLocalField(a5),FIELD_NEXT(a0) move.l a0,FirstLocalField(a5) jmp (a2) DIMLONG_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstLocalField(a5),FIELD_NEXT(a0) move.l a0,FirstLocalField(a5) jmp (a2) DIMREAL_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstLocalField(a5),FIELD_NEXT(a0) move.l a0,FirstLocalField(a5) jmp (a2) DIMTEXT_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstLocalField(a5),FIELD_NEXT(a0) move.l a0,FirstLocalField(a5) bsr AddTextField move.l FIELD_MEM(a0),a1 add.l FIELD_MEMSIZE(a0),a1 move.l FIELD_MEM(a0),a0 bsr ClearTextField jmp (a2) DIMSHAREDDOUB_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #3,d7 bsr DimField move.l FirstGlobalField(a5),FIELD_NEXT(a0) move.l a0,FirstGlobalField(a5) jmp (a2) DIMSHAREDINT_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #1,d7 bsr DimField move.l FirstGlobalField(a5),FIELD_NEXT(a0) move.l a0,FirstGlobalField(a5) jmp (a2) DIMSHAREDLONG_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstGlobalField(a5),FIELD_NEXT(a0) move.l a0,FirstGlobalField(a5) jmp (a2) DIMSHAREDREAL_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstGlobalField(a5),FIELD_NEXT(a0) move.l a0,FirstGlobalField(a5) jmp (a2) DIMSHAREDTEXT_FP_ move.l (sp)+,a2 move.l (sp)+,a0 moveq #2,d7 bsr DimField move.l FirstGlobalField(a5),FIELD_NEXT(a0) move.l a0,FirstGlobalField(a5) bsr AddTextField move.l FIELD_MEM(a0),a1 add.l FIELD_MEMSIZE(a0),a1 move.l FIELD_MEM(a0),a0 bsr ClearTextField jmp (a2) DimField move.l (sp)+,d6 tst.l FIELD_MEM(a0) bne ErrorDuplicateDefinition lea FIELD_NUMDIMS(a0),a1 move.w (sp)+,d0 move.w d0,(a1)+ moveq #1,d1 DimFieldLoop moveq #0,d2 move.w (sp)+,d2 bmi ErrorIllegalFunctionCall addq.l #1,d2 move.w d2,(a1)+ move.l d1,d3 swap d3 mulu d2,d3 swap d3 tst.w d3 bne ErrorIllegalFunctionCall mulu d2,d1 add.l d3,d1 bvs ErrorIllegalFunctionCall dbra d0,DimFieldLoop lsl.l d7,d1 move.l d1,FIELD_MEMSIZE(a0) move.l d1,d0 moveq #0,d1 bsr MyAllocMem move.l d0,FIELD_MEM(a0) move.l d6,-(sp) rts GETDOUBELEM_FP_D move.l (sp)+,a2 moveq #3,d7 bsr GetElemPointer move.l (a0)+,d0 move.l (a0),-(sp) move.l d0,-(sp) jmp (a2) GETINTELEM_FP_I move.l (sp)+,a2 moveq #1,d7 bsr GetElemPointer move.w (a0),-(sp) jmp (a2) GETLONGELEM_FP_L move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l (a0),-(sp) jmp (a2) GETREALELEM_FP_R move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l (a0),-(sp) jmp (a2) GETTEXTELEM_FP_T move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) GETDOUBELEMPOINTER_FP_L move.l (sp)+,a2 moveq #3,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) GETINTELEMPOINTER_FP_L move.l (sp)+,a2 moveq #1,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) GETLONGELEMPOINTER_FP_L move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) GETREALELEMPOINTER_FP_L move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) GETTEXTELEMPOINTER_FP_L move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l a0,-(sp) jmp (a2) SETDOUBELEM_DFP_ move.l (sp)+,a2 moveq #3,d7 bsr GetElemPointer move.l (sp)+,(a0)+ move.l (sp)+,(a0) jmp (a2) SETINTELEM_IFP_ move.l (sp)+,a2 moveq #1,d7 bsr GetElemPointer move.w (sp)+,(a0) jmp (a2) SETLONGELEM_LFP_ move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l (sp)+,(a0) jmp (a2) SETREALELEM_RFP_ move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l (sp)+,(a0) jmp (a2) SETTEXTELEM_TFP_ move.l (sp)+,a2 moveq #2,d7 bsr GetElemPointer move.l (sp)+,a1 move.l (a1),(a0) jmp (a2) ; a2 darf nicht verändert werden, das Ergebnis steht in a0 (Zeiger auf Elem) GetElemPointer move.l (sp)+,d6 move.l (sp)+,a0 tst.l FIELD_MEM(a0) beq ErrorSubscriptOutOfRange move.w (sp)+,d1 cmp.w FIELD_NUMDIMS(a0),d1 bne ErrorSubscriptOutOfRange lea FIELD_FIRSTDIM(a0),a1 moveq #0,d0 ; Elementnummer GetElemNumLoop move.w (a1)+,d3 ; Faktor holen move.l d0,d4 swap d4 mulu d3,d4 swap d4 mulu d3,d0 add.l d4,d0 moveq #0,d2 move.w (sp)+,d2 cmp.w d3,d2 bcc ErrorSubscriptOutOfRange add.l d2,d0 dbra d1,GetElemNumLoop lsl.l d7,d0 move.l FIELD_MEM(a0),a0 add.l d0,a0 move.l d6,-(sp) rts ; ********************************************************************** ; * * ; * Fehlerbehandlung * ; * * ; ********************************************************************** ; ; Darf sich nur auf die Libraries verlassen! ; Error Break_Off move.b #-1,ErrorOccured(a5) ; Text für den Fehler suchen lea ErrorTable,a2 FindingLoop move.b (a2)+,d1 bmi.s EndOfTableReached cmp.b d1,d0 beq.s FoundErrorText FindEndOfErrorText tst.b (a2)+ bne.s FindEndOfErrorText bra.s FindingLoop FoundErrorText EndOfTableReached CallDOS Output move.l d0,d7 ble NoStdOutPut move.l d7,d1 move.l #ErrorText1,d2 moveq #ErrorText1End-ErrorText1,d3 CallDOS Write move.l d7,d1 move.l a2,d2 FindEndLoop tst.b (a2)+ bne.s FindEndLoop move.l a2,d3 sub.l d2,d3 subq.l #1,d3 CallDOS Write tst.l ThisSourceLine(a5) beq NoSourceLineSet move.l d7,d1 move.l #ErrorLineText1,d2 moveq #ErrorLineText1End-ErrorLineText1,d3 CallDOS Write lea ErrorLongVarString,a0 lea ThisSourceLine(a5),a1 lea RawDoFmtProc,a2 lea ErrorLongBuffer(a5),a3 CallSys RawDoFmt move.l d7,d1 lea ErrorLongBuffer(a5),a0 move.l a0,d2 FindErrorLineEndLoop tst.b (a0)+ bne.s FindErrorLineEndLoop move.l a0,d3 sub.l d2,d3 subq.l #1,d3 CallDOS Write move.l d7,d1 move.l #ErrorLineText2,d2 moveq #ErrorLineText2End-ErrorLineText2,d3 CallDOS Write NoSourceLineSet move.l d7,d1 move.l #ErrorText2,d2 moveq #ErrorText2End-ErrorText2,d3 CallDOS Write bra END___NoCheck ErrorText1 dc.b 13,'Basic-Error: ' ErrorText1End ErrorLineText1 dc.b ' (Line ' ErrorLineText1End ErrorLineText2 dc.b ')' ErrorLineText2End ErrorText2 dc.b 10 ErrorText2End ErrorLongVarString dc.b '%ld',0 even NoStdOutPut lea IntuiText(a5),a0 clr.b (a0)+ move.b #1,(a0)+ move.b #1,(a0)+ clr.b (a0)+ move.w #10,(a0)+ move.w #10,(a0)+ clr.l (a0)+ move.l a2,(a0)+ clr.l (a0) sub.l a0,a0 lea IntuiText(a5),a1 sub.l a2,a2 lea ContinueIntuiText,a3 moveq #0,d0 moveq #0,d1 move.l #400,d2 moveq #60,d3 CallIntuition AutoRequest bra END___NoCheck ContinueIntuiText dc.b 0,1,1,0 dc.w 5,3 dc.l 0,PositiveText,0 PositiveText dc.b " Continue",0 even ; Fehlertabelle ErrorTable dc.b 03,'RETURN without GOSUB',0 dc.b 04,'Out of data',0 dc.b 05,'Illegal function call',0 dc.b 06,'Overflow',0 dc.b 07,'Out of memory',0 dc.b 09,'Subscript out of range',0 dc.b 10,'Duplicate definition',0 dc.b 11,'Division by zero',0 dc.b 14,'Out of heap space',0 dc.b 15,'String too long',0 dc.b 19,'No RESUME',0 dc.b 20,'RESUME without error',0 dc.b 23,'Line buffer overflow',0 dc.b 50,'FIELD overflow',0 dc.b 52,'Bad file number',0 dc.b 53,'File not found',0 dc.b 54,'Bad file mode',0 dc.b 55,'File already open',0 dc.b 57,'Device I/O error',0 dc.b 58,'File already exists',0 dc.b 61,'Disk full',0 dc.b 62,'Input past end',0 dc.b 63,'Bad record number',0 dc.b 64,'Bad file name',0 dc.b 68,'Device unavailable',0 dc.b 70,'Permission denied',0 dc.b 73,'Advanced feature',0 dc.b 74,'Unknown Volume',0 dc.b 100,'Cannot open Window',0 dc.b 101,'Stack overflow',0 dc.b 102,'Internal Error: FreeMem',0 dc.b 103,'Could not open Console',0 dc.b 104,'No math.library',0 dc.b 105,'No mathtrans.library',0 dc.b 106,'No mathieeedoubbas.library',0 dc.b 107,'No mathieeedoubtrans.library',0 dc.b 108,'Garbagecollection out of Memory',0 dc.b 109,'I/O error',0 dc.b 110,'File is not a directory',0 dc.b 111,'Internal error: stack trashed',0 dc.b 112,'Could not alloc trap 7',0 dc.b -1,"Unprintable error",0 even ErrorReturnWithoutGosub moveq #3,d0 bra Error ErrorOutOfData moveq #4,d0 bra Error ErrorIllegalFunctionCall moveq #5,d0 bra Error ErrorOverflow moveq #6,d0 bra Error ErrorOutOfMemory moveq #7,d0 bra Error ErrorSubscriptOutOfRange moveq #9,d0 bra Error ErrorDuplicateDefinition moveq #10,d0 bra Error ErrorDivisionByZero moveq #11,d0 bra Error ErrorOutOfHeapSpace moveq #14,d0 bra Error ErrorStringTooLong moveq #15,d0 bra Error ErrorNoResume moveq #19,d0 bra Error ErrorResumeWithoutError moveq #20,d0 bra Error ErrorLineBufferOverflow moveq #23,d0 bra Error ErrorFieldOverflow moveq #50,d0 bra Error ErrorBadFileNumber moveq #52,d0 bra Error ErrorFileNotFound moveq #53,d0 bra Error ErrorBadFileMode moveq #54,d0 bra Error ErrorFileAlreadyOpen moveq #55,d0 bra Error ErrorDeviceIoError moveq #57,d0 bra Error ErrorFileAlreadyExists moveq #58,d0 bra Error ErrorDiskFull moveq #61,d0 bra Error ErrorInputPastEnd moveq #62,d0 bra Error ErrorBadRecordNumber moveq #63,d0 bra Error ErrorBadFileName moveq #64,d0 bra Error ErrorDeviceUnavailable moveq #68,d0 bra Error ErrorPermissionDenied moveq #70,d0 bra Error ErrorAdvancedFeature moveq #73,d0 bra Error ErrorUnknownVolume moveq #74,d0 bra Error ErrorCannotOpenWindow moveq #100,d0 bra Error ErrorStackOverflow moveq #101,d0 bra Error ErrorFreeMem moveq #102,d0 bra Error ErrorCouldNotOpenConsole moveq #103,d0 bra Error ErrorNoMathLibrary moveq #104,d0 bra Error ErrorNoMathTransLibrary moveq #105,d0 bra Error ErrorNoMathIeeeDoubBasLibrary moveq #106,d0 bra Error ErrorNoMathIeeeDoubTransLibrary moveq #107,d0 bra Error ErrorGarbageCollectionOutOfMemory moveq #108,d0 bra Error ErrorIO moveq #109,d0 bra Error ErrorNoDirectory moveq #110,d0 bra Error ErrorStackTrashed moveq #111,d0 bra Error ErrorNoTrapSeven moveq #112,d0 bra Error ; Tabelle der Ein-/Ausgabefehler IOErrorTable: dc.b 103,'NO FREE STORE',0 dc.b 105,'TASK TABLE FULL',0 dc.b 120,'LINE TOO LONG',0 dc.b 121,'FILE NOT OBJECT',0 dc.b 122,'INVALID RESIDENT LIBRARY',0 dc.b 201,'NO DEFAULT DIR',0 dc.b 202,'OBJECT IN USE',0 dc.b 203,'OBJECT EXISTS',0 dc.b 204,'DIR NOT FOUND',0 dc.b 205,'OJBECT NOT FOUND',0 dc.b 206,'BAD STREAM NAME',0 dc.b 207,'OBJECT TOO LARGE',0 dc.b 209,'ACTION NOT KNOWN',0 dc.b 210,'INVALID COMPONENT NAME',0 dc.b 211,'INVALID LOCK',0 dc.b 212,'OBJECT WRONG TYPE',0 dc.b 213,'DISK NOT VALIDATED',0 dc.b 214,'DISK WRITE PROTECTED',0 dc.b 215,'RENAME ACROSS DEVICES',0 dc.b 216,'DIRECTORY NOT EMPTY',0 dc.b 217,'TOO MANY LEVELS',0 dc.b 218,'DEVICE NOT MOUNTED',0 dc.b 219,'SEEK ERROR',0 dc.b 220,'COMMENT TOO BIG',0 dc.b 221,'DISK FULL',0 dc.b 222,'DELETE PROTECTED',0 dc.b 223,'WRITE PROTECTED',0 dc.b 224,'READ PROTECTED',0 dc.b 225,'NOT A DOS DISK',0 dc.b 226,'NO DISK',0 dc.b 232,'NO MORE ENTRIES',0 dc.b -1 ; ********************************************************************** ; * * ; * Stringunterstützung * ; * * ; ********************************************************************** ; Um einen String zu erzeugen muß CreateString aufgerufen werden. ; In A3.w steht zunächst die größtmögliche Länge des Strings oder die ; genau Länge (wird zum Test auf Garbage-Collection benutzt) ; A3 zeigt dann auf einen Zeiger auf die Länge des neuen Strings. ; Auf jedes CreateString muß ein FinishStringCGarbage folgen! CreateString movem.l d0/d1/a0,-(sp) ; Auf Garbage-Collection testen move.w a3,d0 bmi ErrorStringTooLong ext.l d0 addq.l #8,d0 bclr #0,d0 add.l FreeStringPointer(a5),d0 move.l StringsMem(a5),d1 add.l StringsMemSize(a5),d1 cmp.l d1,d0 blt.s NoNeedGarbageCollection sub.l FreeStringPointer(a5),d0 movem.l d0-a3,-(sp) bsr DoGarbageCollection movem.l (sp)+,d0-a3 add.l FreeStringPointer(a5),d0 cmp.l d1,d0 bge ErrorGarbageCollectionOutOfMemory NoNeedGarbageCollection ; Neuen String besorgen move.l FreeStringPointer(a5),a3 clr.l (a3)+ move.w TempNumber(a5),d0 lsl.w #2,d0 lea TempMem(a5,d0.w),a0 move.l a3,(a0) move.l a0,a3 move.w TempNumber(a5),d0 addq.w #1,d0 cmp.w #MAXTEMP,d0 bne.s NotLastPosReached moveq #0,d0 NotLastPosReached move.w d0,TempNumber(a5) movem.l (sp)+,d0/d1/a0 rts ; FinishString geht davon aus, daß FreeStringPointer(a5) noch erhöht werden ; muß. Beim Aufruf von FinishString zeigt er auf das Longword vor der Länge ; des neu hinzugefügten Strings. Es wird ein Nullbyte hinten an den String ; angefügt (für C-Strings). ; Auf jedes CreateString muß ein FinishString folgen! FinishString movem.l d0/a0,-(sp) ; alten String fertig machen move.l FreeStringPointer(a5),a0 addq.l #4,a0 add.w (a0)+,a0 clr.b (a0)+ move.l a0,d0 addq.l #1,d0 bclr #0,d0 move.l d0,FreeStringPointer(a5) movem.l (sp)+,d0/a0 rts ; ********************************************************************** ; * * ; * Garbage-Collection ausführen * ; * * ; ********************************************************************** DoGarbageCollection ; Grenzen des Speichers für Strings move.l StringsMem(a5),d4 move.l d4,d5 add.l StringsMemSize(a5),d5 ; Pass1 ; Markieren der noch benötigten Strings lea TempField(a5),a0 Pass1_NextTextField move.l FIELD_MEM(a0),a1 move.l FIELD_MEMSIZE(a0),d0 bra.s Pass1_EnterLoop Pass1_Loop move.l (a1)+,a2 tst.w (a2) beq.s Pass1_StringEmpty cmp.l d4,a2 blt.s Pass1_NotInStringsMem cmp.l d5,a2 bgt.s Pass1_NotInStringsMem move.w #1,-(a2) ; Diesen String markieren Pass1_NotInStringsMem Pass1_StringEmpty Pass1_EnterLoop subq.l #4,d0 bpl.s Pass1_Loop move.l FIELD_TEXTSUCC(a0),a0 move.l a0,d0 bne.s Pass1_NextTextField ; Pass2 ; Errechnen der neuen Stellen der Strings move.l StringsMem(a5),a0 addq.l #4,a0 ; a0: Zeiger auf alte Position move.l a0,a1 ; a1: Zeiger auf die neue Position Pass2_NotReady move.w (a0),d0 ; d0: Offset zum nächsten String addq.w #8,d0 bclr #0,d0 tst.w -2(a0) ; Ist dieser markiert? beq.s Pass2_StringNotNeeded move.l a1,-4(a0) ; Neue Position eintragen add.w d0,a1 ; auch neuen Zeiger erhöhen Pass2_StringNotNeeded add.w d0,a0 ; zum nächsten String cmp.l FreeStringPointer(a5),a0 blt.s Pass2_NotReady ; Pass3 ; Ändern der Zeiger der String-Variablen lea TempField(a5),a0 Pass3_NextTextField move.l FIELD_MEM(a0),a1 move.l FIELD_MEMSIZE(a0),d0 bra.s Pass3_EnterLoop Pass3_Loop move.l (a1),a2 tst.w (a2) beq.s Pass3_StringEmpty cmp.l d4,a2 blt.s Pass3_NotInStringsMem cmp.l d5,a2 bgt.s Pass3_NotInStringsMem move.l -4(a2),(a1) bra.s Pass3_StringNotEmpty Pass3_StringEmpty lea NullWord,a2 move.l a2,(a1) Pass3_StringNotEmpty Pass3_NotInStringsMem addq.l #4,a1 Pass3_EnterLoop subq.l #4,d0 bpl.s Pass3_Loop move.l FIELD_TEXTSUCC(a0),a0 move.l a0,d0 bne.s Pass3_NextTextField ; Pass4 ; Zusammenkopieren der Strings move.l StringsMem(a5),a1 ; Zeiger auf das Ziel der Strings lea 4(a1),a0 ; Zeiger zum Auslesen der alten Strings Pass4_Loop cmp.l FreeStringPointer(a5),a0 bge.s Pass4_Ready move.w (a0)+,d0 tst.l -6(a0) beq.s Pass4_SkipThisString clr.l (a1)+ move.w d0,(a1)+ lsr.w #1,d0 Pass4_WordCopyLoop move.w (a0)+,(a1)+ dbra d0,Pass4_WordCopyLoop addq.l #4,a0 bra.s Pass4_Loop Pass4_SkipThisString addq.w #6,d0 bclr #0,d0 add.w d0,a0 bra.s Pass4_Loop Pass4_Ready move.l a1,FreeStringPointer(a5) rts END