Amiga ISO Collection

home *** CD-ROM | disk | FTP | other *** search

/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-2.LHA / CLISP960530-di.lha / diffs-src-14.8.96-jch < prev next >

Wrap

C/C++ Source or Header | 1996-08-15 | 110.2 KB | 3,126 lines

Only in src/: affi.d Only in src/: affi1.fas Only in src/: affi1.lib Only in src/: affi1.lsp diff -c2 src.orig/amiga.d src/amiga.d *** src.orig/amiga.d Mon Apr 15 16:28:58 1996 --- src/amiga.d Sun Jul 21 19:17:00 1996 *************** *** 27,45 **** - # Wir definieren dieses selbst, brauchen nur Teile von <exec/types.h>: - #define BYTE OS_BYTE - #define UBYTE OS_UBYTE - #define WORD OS_WORD - #define UWORD OS_UWORD - #define LONG OS_LONG - #define ULONG OS_ULONG #include <exec/types.h> - #undef ULONG - #undef LONG - #undef UWORD - #undef WORD - #undef UBYTE - #undef BYTE - #include <exec/memory.h> # für Allocate()-Deklaration, MEMF_24BITDMA #include <exec/execbase.h> # für SysBase, AFF_680x0 --- 27,31 ---- *************** *** 51,71 **** #endif ! #if defined(GNU_INLINES) ! # M. Wilds Prototypen inline/?*.h weichen von den offiziellen ab! ! #define ASTRING STRPTR ! #ifndef GNU_INLINES_LATE ! #include <inline/exec.h> ! #include <inline/dos.h> ! #endif ! #else ! # das sind die offiziellen Prototypen: ! #define ASTRING UBYTE* ! #ifdef ANSI ! #include <clib/exec_protos.h> ! #include <clib/dos_protos.h> ! #endif #endif # BCPL-Pointer (hier BCPL* genannt, Typ BPTR) sind durch 4 teilbare Adressen, # die durch 4 dividiert wurden. --- 37,55 ---- #endif ! #ifdef GNU ! # Expandiere alle Betriebssystem-Aufrufe inline, mit Kamil Iskra inlines.h ! #define GNU_INLINES #endif + #define Class OS_Class # Shadowing intuition/classes.h + + # das sind die Compiler-spezifischen Prototypen: + # Bei GCC werden dabei inline/...h gelesen, das sind Macros + #define ASTRING UBYTE* + #include <proto/exec.h> + #include <proto/dos.h> + #undef Class + # BCPL-Pointer (hier BCPL* genannt, Typ BPTR) sind durch 4 teilbare Adressen, # die durch 4 dividiert wurden. *************** *** 86,89 **** --- 70,83 ---- + # Information über die eigene Task. + extern struct ExecBase * const SysBase; + # wird verwendet von SPVW + + + # Versionsabfragen: + extern struct DosLibrary * const DOSBase; + # wird verwendet von STREAM + + # Deklaration von Typen von Ein-/Ausgabe-Parametern von Betriebssystemfunktionen #define CONST *************** *** 98,101 **** --- 92,98 ---- + # Die Inlines sind jetzt Macros, also können Funktionen nicht mehr deklariert werden + #if !defined(GNU_INLINES) + # Holt das aktuelle Datum und die aktuelle Uhrzeit. # DateStamp(&datestamp); *************** *** 119,122 **** --- 116,124 ---- # wird verwendet von ERROR, PATHNAME + # Setzt die nächste Fehlernummer. + # olderrno = SetIoErr(errno); + extern LONG SetIoErr (LONG); + # wird verwendet von ERROR + # Öffnet eine Datei. *************** *** 130,138 **** # Schließt eine Datei. ! # Close(handle) # > handle: Handle eines offenen Files ! # < ergebnis: keins! extern LONG Close (Handle handle); # siehe dos.library/Close ! #define CLOSE(handle) (Close(handle),0) # wird verwendet von SPVW, PATHNAME, STREAM --- 132,140 ---- # Schließt eine Datei. ! # ergebnis = Close(handle) # > handle: Handle eines offenen Files ! # < ergebnis: NULL bei Fehler. extern LONG Close (Handle handle); # siehe dos.library/Close ! # define CLOSE(handle) (Close(handle),0) # wird verwendet von SPVW, PATHNAME, STREAM *************** *** 281,285 **** # WaitForChar(handle,timeout) # > handle: Handle eines (offenen) interaktiven Files ! # > timeout: maximale Wartezeit (>0), in Mikrosekunden # < ergebnis: gibt an, ob bis zum Ende der Wartezeit ein Zeichen lesbar ist. extern LONG WaitForChar (Handle handle, long timeout); --- 283,287 ---- # WaitForChar(handle,timeout) # > handle: Handle eines (offenen) interaktiven Files ! # > timeout: maximale Wartezeit (>=0), in Mikrosekunden # < ergebnis: gibt an, ob bis zum Ende der Wartezeit ein Zeichen lesbar ist. extern LONG WaitForChar (Handle handle, long timeout); *************** *** 291,296 **** # > mode: 1 für RAW, 0 für CON # < ergebnis: 0 falls nicht erfolgreich (Modus ließ sich nicht umsetzen) - # Diese Funktion gab es vor dos.library 2.0 nicht, deswegen wird stattdessen - # setmode() aus Jörgs Library jchlib/misc/setmode.c oder stream.d verwendet. extern LONG SetMode (BPTR handle, long mode); # siehe dos.library/SetMode # wird verwendet von STREAM --- 293,296 ---- *************** *** 313,320 **** - # Information über die eigene Task. - extern struct ExecBase * SysBase; - # wird verwendet von SPVW - # Liefert einen Pointer auf die eigene Task. # FindTask(NULL) --- 313,316 ---- *************** *** 361,364 **** --- 357,365 ---- # wird verwendet von DEBUG + #endif # GNU_INLINES + + # ignoriere Ergebnis, was sollen wir tun können? + #define CLOSE(handle) (Close(handle),0) + # Sofortiger Programmabbruch, Sprung in den Debugger #if defined(GNU) && 0 # Jörg mag das nicht so sehr bis überhaupt nicht *************** *** 371,376 **** # non fermés, des «Lock» alloués, etc. Jörg 7.1.1993 #define abort() \ ! { asciz_out(CRLFstring "CLISP panic! (going into endless loop)" CRLFstring); \ ! Wait(0L); \ } #else --- 372,377 ---- # non fermés, des «Lock» alloués, etc. Jörg 7.1.1993 #define abort() \ ! { asciz_out(CRLFstring "CLISP panic! (halting)" CRLFstring); \ ! Wait(0L); \ } #else *************** *** 381,389 **** #endif # wird verwendet von EVAL, IO - - - # Versionsabfragen: - extern struct DosLibrary * DOSBase; - # wird verwendet von STREAM --- 382,385 ---- diff -c2 src.orig/amiga2.d src/amiga2.d *** src.orig/amiga2.d Mon Apr 15 16:28:58 1996 --- src/amiga2.d Wed Jun 12 07:14:33 1996 *************** *** 1,6 **** # Include-File: Amiga-Spezifisches, das nur von wenigen Modulen benötigt wird ! # Jörg Höhle 4.3.1995 # Verhindert Multitasking kurzzeitig. # Forbid(); ... Permit(); --- 1,11 ---- # Include-File: Amiga-Spezifisches, das nur von wenigen Modulen benötigt wird ! # Jörg Höhle 12.6.1996 + #include <proto/alib.h> + + # Die Inlines sind jetzt Macros, also können Funktionen nicht mehr deklariert werden + #if !defined(GNU_INLINES) + # Verhindert Multitasking kurzzeitig. # Forbid(); ... Permit(); *************** *** 87,90 **** --- 92,97 ---- #endif + #endif # GNU_INLINES + #ifdef REXX *************** *** 94,104 **** #include <rexx/rxslib.h> ! #if defined(GNU_INLINES) ! #include <inline/rexxsyslib.h> ! #else ! #ifdef ANSI ! #include <clib/rexxsyslib_protos.h> ! #endif ! #endif # Arexx-Messages haben ein spezielles Aussehen: --- 101,107 ---- #include <rexx/rxslib.h> ! #include <proto/rexxsyslib.h> ! ! #if !defined(GNU_INLINES) # Arexx-Messages haben ein spezielles Aussehen: *************** *** 159,162 **** --- 162,167 ---- extern BOOL FillRexxMsg (struct RexxMsg * msg, ULONG argcount, ULONG mask); # siehe rexxsyslib.library/FillRexxMsg # wird verwendet von + + #endif # GNU_INLINES #define RXERRORIMGONE 100L Only in src/: ari68000.d Only in src/: ari68000.mit.d Only in src/: ari68000.mot.d Only in src/: ari68020.d Only in src/: ari68020.mit.d Only in src/: ari68020.mot.d Only in src/: aridecl.d Only in src/: arilev0.d Only in src/: arilev1.d Only in src/: arilev1c.d Only in src/: arilev1e.d Only in src/: arilev1i.d Only in src/: array.d Only in src/: avl.d Only in src/: backquot.fas Only in src/: backquot.lib Only in src/: backquot.lsp Only in src/: bytecode.d diff -c2 src.orig/cfgamiga.lsp src/cfgamiga.lsp *** src.orig/cfgamiga.lsp Mon Apr 15 16:29:16 1996 --- src/cfgamiga.lsp Wed Jul 24 09:47:10 1996 *************** *** 8,12 **** (defun machine-type () "Amiga") ! (defun machine-version () "Amiga, OS 1.2-3.1") (defun machine-instance () "Heinrich Mustermanns Amiga") ;"Smith's Amiga" --- 8,12 ---- (defun machine-type () "Amiga") ! (defun machine-version () "Amiga, OS 2.04-3.1") (defun machine-instance () "Heinrich Mustermanns Amiga") ;"Smith's Amiga" *************** *** 23,27 **** ;; DEUTSCH: Der Name des Editors: ;; FRANCAIS: Nom de l'éditeur : ! (defparameter *editor* "ed") ;; ENGLISH: The temporary file LISP creates for editing: --- 23,28 ---- ;; DEUTSCH: Der Name des Editors: ;; FRANCAIS: Nom de l'éditeur : ! (defparameter *editor* "emacs") ! (defun editor-name () (or (sys::getenv "EDITOR") *editor*)) ;; ENGLISH: The temporary file LISP creates for editing: Only in src/: charstrg.d Only in src/: clos.fas Only in src/: clos.lib Only in src/: clos.lsp Only in src/: compelem.d Only in src/: compiler.fas Only in src/: compiler.lib diff -c2 src.orig/compiler.lsp src/compiler.lsp *** src.orig/compiler.lsp Fri May 03 14:40:26 1996 --- src/compiler.lsp Wed Aug 07 01:19:14 1996 *************** *** 3263,3268 **** (if (atom funname) (values (symbol-name funname) (symbol-package funname)) ! (values (concatenate 'string "(" (symbol-name (first funname)) " " ! (symbol-name (second funname)) ")" ) (symbol-package (second funname)) --- 3263,3268 ---- (if (atom funname) (values (symbol-name funname) (symbol-package funname)) ! (values (string-concat "(" (symbol-name (first funname)) " " ! (symbol-name (second funname)) ")" ) (symbol-package (second funname)) *************** *** 3283,3287 **** ) ) ; neues Symbol bilden: ! (let ((new-name (concatenate 'string name "-" suffix))) (if pack (intern new-name pack) (make-symbol new-name)) ) ) ) ) --- 3283,3287 ---- ) ) ; neues Symbol bilden: ! (let ((new-name (string-concat name "-" suffix))) (if pack (intern new-name pack) (make-symbol new-name)) ) ) ) ) *************** *** 3321,3331 **** (defun c-warn (cstring &rest args) (setq cstring ! (concatenate 'string ! #L{ ! DEUTSCH "~%WARNUNG~@[ in Funktion ~S~]~A :~%" ! ENGLISH "~%WARNING~@[ in function ~S~]~A :~%" ! FRANCAIS "~%AVERTISSEMENT~@[ dans la fonction ~S~]~A :~%" ! } ! cstring ) ) (incf *warning-count*) --- 3321,3331 ---- (defun c-warn (cstring &rest args) (setq cstring ! (string-concat ! #L{ ! DEUTSCH "~%WARNUNG~@[ in Funktion ~S~]~A :~%" ! ENGLISH "~%WARNING~@[ in function ~S~]~A :~%" ! FRANCAIS "~%AVERTISSEMENT~@[ dans la fonction ~S~]~A :~%" ! } ! cstring ) ) (incf *warning-count*) *************** *** 12104,12108 **** (flet ((PC->label-a (PC) (cons PC (make-symbol ! (concatenate 'string "L" (prin1-to-string PC)) ) ) ) (next-byte () (incf PC) (pop byte-list)) --- 12104,12108 ---- (flet ((PC->label-a (PC) (cons PC (make-symbol ! (string-concat "L" (prin1-to-string PC)) ) ) ) (next-byte () (incf PC) (pop byte-list)) Only in src/: comptran.d Only in src/: conditio.fas Only in src/: conditio.lib Only in src/: conditio.lsp Only in src/: config.fas Only in src/: config.lib diff -c2 src.orig/config.lsp src/config.lsp *** src.orig/config.lsp Mon Apr 15 16:29:16 1996 --- src/config.lsp Wed Jul 24 09:47:10 1996 *************** *** 8,12 **** (defun machine-type () "Amiga") ! (defun machine-version () "Amiga, OS 1.2-3.1") (defun machine-instance () "Heinrich Mustermanns Amiga") ;"Smith's Amiga" --- 8,12 ---- (defun machine-type () "Amiga") ! (defun machine-version () "Amiga, OS 2.04-3.1") (defun machine-instance () "Heinrich Mustermanns Amiga") ;"Smith's Amiga" *************** *** 23,27 **** ;; DEUTSCH: Der Name des Editors: ;; FRANCAIS: Nom de l'éditeur : ! (defparameter *editor* "ed") ;; ENGLISH: The temporary file LISP creates for editing: --- 23,28 ---- ;; DEUTSCH: Der Name des Editors: ;; FRANCAIS: Nom de l'éditeur : ! (defparameter *editor* "emacs") ! (defun editor-name () (or (sys::getenv "EDITOR") *editor*)) ;; ENGLISH: The temporary file LISP creates for editing: Only in src/: constobj.d Only in src/: constpack.d diff -c2 src.orig/constsym.d src/constsym.d *** src.orig/constsym.d Fri Apr 26 14:56:56 1996 --- src/constsym.d Tue Jun 11 19:50:00 1996 *************** *** 950,954 **** #ifdef AMIGAOS LISPSYM(foreign_library,"FOREIGN-LIBRARY",ffi) ! LISPSYM(foreign_library_variable,"FOREIGN-LIBRARY-VARIABLE",ffi) LISPSYM(foreign_library_function,"FOREIGN-LIBRARY-FUNCTION",ffi) #endif --- 950,954 ---- #ifdef AMIGAOS LISPSYM(foreign_library,"FOREIGN-LIBRARY",ffi) ! LISPSYM(foreign_library_variable,"FOREIGN-ADDRESS-VARIABLE",ffi) LISPSYM(foreign_library_function,"FOREIGN-LIBRARY-FUNCTION",ffi) #endif Only in src/: control.d Only in src/: dbxtypes.d Only in src/: debug.d Only in src/: defmacro.fas Only in src/: defmacro.lib Only in src/: defmacro.lsp Only in src/: defs1.fas Only in src/: defs1.lib Only in src/: defs1.lsp Only in src/: defs2.fas Only in src/: defs2.lib Only in src/: defs2.lsp Only in src/: defs3.fas Only in src/: defs3.lib Only in src/: defs3.lsp Only in src/: defseq.fas Only in src/: defseq.lib Only in src/: defseq.lsp Only in src/: defstruc.fas Only in src/: defstruc.lib Only in src/: defstruc.lsp Only in src/: dfloat.d Only in src/: disassem.lsp Only in src/: editor.fas Only in src/: editor.lib diff -c2 src.orig/editor.lsp src/editor.lsp *** src.orig/editor.lsp Mon Apr 15 16:29:42 1996 --- src/editor.lsp Wed Jul 24 09:37:19 1996 *************** *** 19,25 **** (defmacro with-window (&body body) ! `(LET* ((*WINDOW* (SCREEN:MAKE-WINDOW)) ! #+AMIGA (*KEYBOARD-INPUT* (SCREEN::MAKE-KEYBOARD-STREAM *WINDOW*)) ! ) (UNWIND-PROTECT (MULTIPLE-VALUE-BIND (GLOBAL-SCREEN-HEIGHT GLOBAL-SCREEN-WIDTH) (SCREEN:WINDOW-SIZE *WINDOW*) --- 19,23 ---- (defmacro with-window (&body body) ! `(LET* ((*WINDOW* (SCREEN:MAKE-WINDOW))) (UNWIND-PROTECT (MULTIPLE-VALUE-BIND (GLOBAL-SCREEN-HEIGHT GLOBAL-SCREEN-WIDTH) (SCREEN:WINDOW-SIZE *WINDOW*) *************** *** 27,31 **** ,@body ) ) - #+AMIGA (CLOSE *KEYBOARD-INPUT*) #+AMIGA (SCREEN:WINDOW-CURSOR-ON *WINDOW*) (CLOSE *WINDOW*) --- 25,28 ---- *************** *** 3035,3046 **** ) (bind-key '(#\Escape #\Code28) ; c-[, c-\ ! :control '(:LEAVE) ' ! #L{ ! DEUTSCH "Editor verlassen" ! ENGLISH "quit editor" ! FRANCAIS "quitter l'éditeur" ! } ) ! (bind-key #\Code29 :control '(:TOP 0) '(C-H-doc 0)) ; c-] ; #\Code30 = c-^ leer ; #\Code31 = c-_ leer --- 3032,3043 ---- ) (bind-key '(#\Escape #\Code28) ; c-[, c-\ ! :control '(:LEAVE) ' ! #L{ ! DEUTSCH "Editor verlassen" ! ENGLISH "quit editor" ! FRANCAIS "quitter l'éditeur" ! } ) ! (bind-key '(#\Code29 #\C-]) :control '(:TOP 0) '(C-H-doc 0)) ; c-] ; #\Code30 = c-^ leer ; #\Code31 = c-_ leer diff -c2 src.orig/error.d src/error.d *** src.orig/error.d Wed May 22 16:09:50 1996 --- src/error.d Sun Jul 21 19:12:25 1996 *************** *** 319,327 **** #ifdef AMIGAOS # Behandlung von AMIGAOS-Fehlern ! # OS_error(); # > IoErr(): Fehlercode ! nonreturning_function(global, OS_error, (void)); ! global void OS_error () ! { var reg1 uintC errcode = IoErr(); # Fehlernummer end_system_call(); clr_break_sem_4(); # keine AMIGAOS-Operation mehr aktiv --- 319,668 ---- #ifdef AMIGAOS # Behandlung von AMIGAOS-Fehlern ! # OS_error_(); # > IoErr(): Fehlercode ! nonreturning_function(global, OS_error_, (void)); ! ! # Tabelle der Fehlermeldungen und ihrer Namen: ! local const char* error100_msg_table[23][2]; ! local const char* error200_msg_table[44][2]; ! local const char* error300_msg_table[6][2]; ! ! # Initialisierung der Tabelle: ! global int init_errormsg_table (void); ! global int init_errormsg_table() ! { ! # A remanescence of pre-gettext times ! #ifdef LANGUAGE_STATIC ! #define lang3(english,deutsch,francais) ENGLISH ? english : DEUTSCH ? deutsch : FRANCAIS ? francais : "" ! #define lang1(string) string ! #define langcount 1 ! #define language 0 ! #else ! #define lang3(english,deutsch,francais) english, deutsch, francais ! #define lang1(string) string, string, string ! #define langcount 3 ! #endif ! error100_msg_table[0][0]=""; error100_msg_table[0][1]=""; ! error100_msg_table[1][0]=""; error100_msg_table[1][1]=""; ! error100_msg_table[2][0]=""; error100_msg_table[2][1]=""; ! ! error100_msg_table[3][0]="ERROR_NO_FREE_STORE"; ! //: DEUTSCH "nicht genügend Speicher vorhanden" ! //: ENGLISH "not enough memory available" ! //: FRANCAIS "Pas assez de mémoire" ! error100_msg_table[3][1]=GETTEXT("not enough memory available"); ! ! error100_msg_table[4][0]=""; error100_msg_table[4][1]=""; ! ! error100_msg_table[5][0]="ERROR_TASK_TABLE_FULL"; ! //: DEUTSCH "keine weiteren CLI Prozesse mehr" ! //: ENGLISH "process table full" ! //: FRANCAIS "La table des processus est pleine" ! error100_msg_table[5][1]=GETTEXT("process table full"); ! ! error100_msg_table[6][0]=""; error100_msg_table[6][1]=""; ! error100_msg_table[7][0]=""; error100_msg_table[7][1]=""; ! error100_msg_table[8][0]=""; error100_msg_table[8][1]=""; ! error100_msg_table[9][0]=""; error100_msg_table[9][1]=""; ! error100_msg_table[10][0]=""; error100_msg_table[10][1]=""; ! error100_msg_table[11][0]=""; error100_msg_table[11][1]=""; ! error100_msg_table[12][0]=""; error100_msg_table[12][1]=""; ! error100_msg_table[13][0]=""; error100_msg_table[13][1]=""; ! ! error100_msg_table[14][0]="ERROR_BAD_TEMPLATE"; ! //: DEUTSCH "ungültiges Muster" ! //: ENGLISH "bad template" ! //: FRANCAIS "mauvais schéma" ! error100_msg_table[14][1]=GETTEXT("bad template"); ! ! error100_msg_table[15][0]="ERROR_BAD_NUMBER"; ! //: DEUTSCH "ungültige Zahl" ! //: ENGLISH "bad number" ! //: FRANCAIS "mauvais nombre" ! error100_msg_table[15][1]=GETTEXT("bad number"); ! ! error100_msg_table[16][0]="ERROR_REQUIRED_ARG_MISSING"; ! //: DEUTSCH "benötigtes Schlüsselwort nicht vorhanden" ! //: ENGLISH "required argument missing" ! //: FRANCAIS "mot clé manque" ! error100_msg_table[16][1]=GETTEXT("required argument missing"); ! ! error100_msg_table[17][0]="ERROR_KEY_NEEDS_ARG"; ! //: DEUTSCH "kein Wert nach Schlüsselwort vorhanden" ! //: ENGLISH "value after keyword missing" ! //: FRANCAIS "mot clé sans valeur" ! error100_msg_table[17][1]=GETTEXT("value after keyword missing"); ! ! error100_msg_table[18][0]="ERROR_TOO_MANY_ARGS"; ! //: DEUTSCH "falsche Anzahl Argumente" ! //: ENGLISH "wrong number of arguments" ! //: FRANCAIS "mauvais nombre d'arguments" ! error100_msg_table[18][1]=GETTEXT("wrong number of arguments"); ! ! error100_msg_table[19][0]="ERROR_UNMATCHED_QUOTES"; ! //: DEUTSCH "ausstehende Anführungszeichen" ! //: ENGLISH "unmatched quotes" ! //: FRANCAIS "guillemets non terminés" ! error100_msg_table[19][1]=GETTEXT("unmatched quotes"); ! ! error100_msg_table[20][0]="ERROR_LINE_TOO_LONG"; ! //: DEUTSCH "ungültige Zeile oder Zeile zu lang" ! //: ENGLISH "argument line invalid or too long" ! //: FRANCAIS "ligne est mauvaise ou trop longue" ! error100_msg_table[20][1]="argument line invalid or too long"; ! ! error100_msg_table[21][0]="ERROR_FILE_NOT_OBJECT"; ! //: DEUTSCH "Datei ist nicht ausführbar" ! //: ENGLISH "file is not executable" ! //: FRANCAIS "fichier non exécutable" ! error100_msg_table[21][1]=GETTEXT("file is not executable"); ! ! error100_msg_table[22][0]="ERROR_INVALID_RESIDENT_LIBRARY"; ! //: DEUTSCH "ungültige residente Library" ! //: ENGLISH "invalid resident library" ! //: FRANCAIS "Librarie résidente non valide" ! error100_msg_table[22][1]=GETTEXT("invalid resident library"); ! ! error200_msg_table[0][0]=""; error200_msg_table[0][1]=""; ! ! error200_msg_table[1][0]="ERROR_NO_DEFAULT_DIR"; ! error200_msg_table[1][1]=""; ! ! error200_msg_table[2][0]="ERROR_OBJECT_IN_USE"; ! //: DEUTSCH "Objekt wird schon benutzt" ! //: ENGLISH "object is in use" ! //: FRANCAIS "l'objet est utilisé" ! error200_msg_table[2][1]=GETTEXT("object is in use"); ! ! error200_msg_table[3][0]="ERROR_OBJECT_EXISTS"; ! //: DEUTSCH "Objekt existiert bereits" ! //: ENGLISH "object already exists" ! //: FRANCAIS "l'objet existe déjà" ! error200_msg_table[3][1]=GETTEXT("object already exists"); ! ! error200_msg_table[4][0]="ERROR_DIR_NOT_FOUND"; ! //: DEUTSCH "Verzeichnis nicht gefunden" ! //: ENGLISH "directory not found" ! //: FRANCAIS "répertoire non trouvé" ! error200_msg_table[4][1]=GETTEXT("directory not found"); ! ! error200_msg_table[5][0]="ERROR_OBJECT_NOT_FOUND"; ! //: DEUTSCH "Objekt nicht gefunden" ! //: ENGLISH "object not found" ! //: FRANCAIS "objet non trouvé" ! error200_msg_table[5][1]=GETTEXT("object not found"); ! ! error200_msg_table[6][0]="ERROR_BAD_STREAM_NAME"; ! //: DEUTSCH "ungültige Fensterbeschreibung" ! //: ENGLISH "invalid window description" ! //: FRANCAIS "mauvais descripteur de fenêtre" ! error200_msg_table[6][1]=GETTEXT("invalid window description"); ! ! error200_msg_table[7][0]="ERROR_OBJECT_TOO_LARGE"; ! //: DEUTSCH "Objekt zu groß" ! //: ENGLISH "object too large" ! //: FRANCAIS "objet trop grand" ! error200_msg_table[7][1]=GETTEXT("object too large"); ! ! error200_msg_table[8][0]=""; error200_msg_table[8][1]=""; ! ! error200_msg_table[9][0]="ERROR_ACTION_NOT_KNOWN"; ! //: DEUTSCH "unbekannter Pakettyp" # ?? ! //: ENGLISH "packet request type unknown" ! //: FRANCAIS "Type de paquet inconnu" ! error200_msg_table[9][1]=GETTEXT("packet request type unknown"); ! ! error200_msg_table[10][0]="ERROR_INVALID_COMPONENT_NAME"; ! //: DEUTSCH "ungültiger Objektname" ! //: ENGLISH "object name invalid" ! //: FRANCAIS "nom d'objet incorrect" ! error200_msg_table[10][1]=GETTEXT("object name invalid"); ! ! error200_msg_table[11][0]="ERROR_INVALID_LOCK"; ! //: DEUTSCH "ungültiger Objektlock" ! //: ENGLISH "invalid object lock" ! //: FRANCAIS "«lock» invalide d'un objet" ! error200_msg_table[11][1]=GETTEXT("invalid object lock"); ! ! error200_msg_table[12][0]="ERROR_OBJECT_WRONG_TYPE"; ! //: DEUTSCH "Objekt ist nicht von benötigten Typ" ! //: ENGLISH "object is not of required type" ! //: FRANCAIS "objet de mauvais type" ! error200_msg_table[12][1]=GETTEXT("object is not of required type"); ! ! error200_msg_table[13][0]="ERROR_DISK_NOT_VALIDATED"; ! //: DEUTSCH "Datenträger ist nicht validiert" ! //: ENGLISH "disk not validated" ! //: FRANCAIS "volume non validé" ! error200_msg_table[13][1]=GETTEXT("disk not validated"); ! ! error200_msg_table[14][0]="ERROR_DISK_WRITE_PROTECTED"; ! //: DEUTSCH "Datenträger ist schreibgeschützt" ! //: ENGLISH "disk is write-protected" ! //: FRANCAIS "disquette protégée contre l'écriture" ! error200_msg_table[14][1]=GETTEXT("disk is write-protected"); ! ! error200_msg_table[15][0]="ERROR_RENAME_ACROSS_DEVICES"; ! //: DEUTSCH "rename über Laufwerke versucht" ! //: ENGLISH "rename across devices attempted" ! //: FRANCAIS "«rename» à travers des unités distinctes" ! error200_msg_table[15][1]=GETTEXT("rename across devices attempted"); ! ! error200_msg_table[16][0]="ERROR_DIRECTORY_NOT_EMPTY"; ! //: DEUTSCH "Verzeichnis ist nicht leer" ! //: ENGLISH "directory not empty" ! //: FRANCAIS "répertoire non vide" ! error200_msg_table[16][1]=GETTEXT("directory not empty"); ! ! error200_msg_table[17][0]="ERROR_TOO_MANY_LEVELS"; ! //: DEUTSCH "zu viele Verweise" ! //: ENGLISH "too many levels" ! //: FRANCAIS "trop de niveaux" ! error200_msg_table[17][1]=GETTEXT("too many levels"); ! ! error200_msg_table[18][0]="ERROR_DEVICE_NOT_MOUNTED"; ! //: DEUTSCH "Datenträger ist in keinem Laufwerk" ! //: ENGLISH "device (or volume) is not mounted" ! //: FRANCAIS "l'unité n'est dans aucun lecteur" ! error200_msg_table[18][1]=GETTEXT("device (or volume) is not mounted"); ! ! error200_msg_table[19][0]="ERROR_SEEK_ERROR"; ! //: DEUTSCH "seek schlug fehl" ! //: ENGLISH "seek failure" ! //: FRANCAIS "erreur pendant un déplacement (seek)" ! error200_msg_table[19][1]=GETTEXT("seek failure"); ! ! error200_msg_table[20][0]="ERROR_COMMENT_TOO_BIG"; ! //: DEUTSCH "Kommentar ist zu lang" ! //: ENGLISH "comment is too long" ! //: FRANCAIS "Commentaire trop long" ! error200_msg_table[20][1]=GETTEXT("comment is too long"); ! ! error200_msg_table[21][0]="ERROR_DISK_FULL"; ! //: DEUTSCH "Datenträger ist voll" ! //: ENGLISH "disk is full" ! //: FRANCAIS "support plein" ! error200_msg_table[21][1]=GETTEXT("disk is full"); ! ! error200_msg_table[22][0]="ERROR_DELETE_PROTECTED"; ! //: DEUTSCH "Datei ist gegen Löschen geschützt" ! //: ENGLISH "object is protected from deletion" ! //: FRANCAIS "objet est protégé contre l'effacement" ! error200_msg_table[22][1]=GETTEXT("object is protected from deletion"); ! ! error200_msg_table[23][0]="ERROR_WRITE_PROTECTED"; ! //: DEUTSCH "Datei ist schreibgeschützt" ! //: ENGLISH "file is write protected" ! //: FRANCAIS "fichier protégé contre l'écriture" ! error200_msg_table[23][1]=GETTEXT("file is write protected"); ! ! error200_msg_table[24][0]="ERROR_READ_PROTECTED"; ! //: DEUTSCH "Datei ist lesegeschützt" ! //: ENGLISH "file is read protected" ! //: FRANCAIS "fichier protégé contre la lecture" ! error200_msg_table[24][1]=GETTEXT("file is read protected"); ! ! error200_msg_table[25][0]="ERROR_NOT_A_DOS_DISK"; ! //: DEUTSCH "kein gültiger DOS-Datenträger" ! //: ENGLISH "not a valid DOS disk" ! //: FRANCAIS "disque non DOS" ! error200_msg_table[25][1]=GETTEXT("not a valid DOS disk"); ! ! error200_msg_table[26][0]="ERROR_NO_DISK"; ! //: DEUTSCH "kein Datenträger im Laufwerk" ! //: ENGLISH "no disk in drive" ! //: FRANCAIS "pas de disquette dans le lecteur" ! error200_msg_table[26][1]=GETTEXT("no disk in drive"); ! ! error200_msg_table[27][0]=""; error200_msg_table[27][1]=""; ! error200_msg_table[28][0]=""; error200_msg_table[28][1]=""; ! error200_msg_table[29][0]=""; error200_msg_table[29][1]=""; ! error200_msg_table[30][0]=""; error200_msg_table[30][1]=""; ! error200_msg_table[31][0]=""; error200_msg_table[31][1]=""; ! ! error200_msg_table[32][0]="ERROR_NO_MORE_ENTRIES"; ! //: DEUTSCH "keine weiteren Verzeichniseinträge mehr" ! //: ENGLISH "no more entries in directory" ! //: FRANCAIS "pas plus d'entrées dans le répertoire" ! error200_msg_table[32][1]=GETTEXT("no more entries in directory"); ! ! error200_msg_table[33][0]="ERROR_IS_SOFT_LINK"; ! //: DEUTSCH "Objekt ist ein Softlink" ! //: ENGLISH "object is soft link" ! //: FRANCAIS "l'objet est un «soft link»" ! error200_msg_table[33][1]=GETTEXT("object is soft link"); ! ! error200_msg_table[34][0]="ERROR_OBJECT_LINKED"; ! //: DEUTSCH "Objekt ist gelinkt" ! //: ENGLISH "object is linked" ! //: FRANCAIS "l'objet est lié" ! error200_msg_table[34][1]=GETTEXT("object is linked"); ! ! error200_msg_table[35][0]="ERROR_BAD_HUNK"; ! //: DEUTSCH "Datei teilweise nicht ladbar" ! //: ENGLISH "bad loadfile hunk" ! //: FRANCAIS "fichier pas entièrement chargeable" ! error200_msg_table[35][1]=GETTEXT("bad loadfile hunk"); ! ! error200_msg_table[36][0]="ERROR_NOT_IMPLEMENTED"; ! //: DEUTSCH "unimplementierte Funktion" ! //: ENGLISH "function not implemented" ! //: FRANCAIS "fonction non implémentée" ! error200_msg_table[36][1]=GETTEXT("function not implemented"); ! ! error200_msg_table[37][0]=""; error200_msg_table[37][1]=""; ! error200_msg_table[38][0]=""; error200_msg_table[38][1]=""; ! error200_msg_table[39][0]=""; error200_msg_table[39][1]=""; ! ! error200_msg_table[40][0]="ERROR_RECORD_NOT_LOCKED"; ! //: DEUTSCH "" ! //: ENGLISH "record not locked" ! //: FRANCAIS "" ! error200_msg_table[40][1]=GETTEXT("record not locked"); ! ! error200_msg_table[41][0]="ERROR_LOCK_COLLISION"; ! //: DEUTSCH "" ! //: ENGLISH "record lock collision" ! //: FRANCAIS "" ! error200_msg_table[41][1]=GETTEXT("record lock collision"); ! ! error200_msg_table[42][0]="ERROR_LOCK_TIMEOUT"; ! //: DEUTSCH "" ! //: ENGLISH "record lock timeout" ! //: FRANCAIS "" ! error200_msg_table[42][1]=GETTEXT("record lock timeout"); ! ! error200_msg_table[43][0]="ERROR_UNLOCK_ERROR"; ! //: DEUTSCH "" ! //: ENGLISH "record unlock error" ! //: FRANCAIS "" ! error200_msg_table[43][1]=GETTEXT("record unlock error"); ! ! error300_msg_table[0][0]=""; error300_msg_table[0][1]=""; ! error300_msg_table[1][0]=""; error300_msg_table[1][1]=""; ! error300_msg_table[2][0]=""; error300_msg_table[2][1]=""; ! ! error300_msg_table[3][0]="ERROR_BUFFER_OVERFLOW"; ! //: DEUTSCH "Puffer-Überlauf" ! //: ENGLISH "buffer overflow" ! //: FRANCAIS "débordement de tampon" ! error300_msg_table[3][1]=GETTEXT("buffer overflow"); ! ! error300_msg_table[4][0]="ERROR_BREAK"; ! //: DEUTSCH "Unterbrechung" ! //: ENGLISH "break" ! //: FRANCAIS "interruption" ! error300_msg_table[4][1]=GETTEXT("break"); ! ! error300_msg_table[5][0]="ERROR_NOT_EXECUTABLE"; ! //: DEUTSCH "Datei ist nicht ausführbar" ! //: ENGLISH "file not executable" ! //: FRANCAIS "fichier non exécutable" ! error300_msg_table[5][1]=GETTEXT("file not executable"); ! return 0; ! } ! ! global void OS_error_ () ! { var reg1 sintW errcode = IoErr(); # Fehlernummer end_system_call(); clr_break_sem_4(); # keine AMIGAOS-Operation mehr aktiv *************** *** 335,351 **** write_errorobject(fixnum(errcode)); { - #ifdef LANGUAGE_STATIC - #define lang3(english,deutsch,francais) ENGLISH ? english : DEUTSCH ? deutsch : FRANCAIS ? francais : "" - #define lang1(string) string - #define langcount 1 - #define language 0 - #else - #define lang3(english,deutsch,francais) english, deutsch, francais - #define lang1(string) string, string, string - #define langcount 3 - #endif - local const char* error100_msg_table[23][2]; - local const char* error200_msg_table[44][2]; - local const char* error300_msg_table[6][2]; var reg3 const char* errorname = ""; var reg3 const char* errormsg = ""; --- 676,679 ---- *************** *** 352,673 **** var reg2 uintC index; - error100_msg_table[0][0]=""; error100_msg_table[0][1]=""; - error100_msg_table[1][0]=""; error100_msg_table[1][1]=""; - error100_msg_table[2][0]=""; error100_msg_table[2][1]=""; - - error100_msg_table[3][0]="ERROR_NO_FREE_STORE"; - //: DEUTSCH "nicht genügend Speicher vorhanden" - //: ENGLISH "not enough memory available" - //: FRANCAIS "Pas assez de mémoire" - error100_msg_table[3][1]=GETTEXT("not enough memory available"); - - error100_msg_table[4][0]=""; error100_msg_table[4][1]=""; - - error100_msg_table[5][0]="ERROR_TASK_TABLE_FULL"; - //: DEUTSCH "keine weiteren CLI Prozesse mehr" - //: ENGLISH "process table full" - //: FRANCAIS "La table des processus est pleine" - error100_msg_table[5][1]=GETTEXT("process table full"); - - error100_msg_table[6][0]=""; error100_msg_table[6][1]=""; - error100_msg_table[7][0]=""; error100_msg_table[7][1]=""; - error100_msg_table[8][0]=""; error100_msg_table[8][1]=""; - error100_msg_table[9][0]=""; error100_msg_table[9][1]=""; - error100_msg_table[10][0]=""; error100_msg_table[10][1]=""; - error100_msg_table[11][0]=""; error100_msg_table[11][1]=""; - error100_msg_table[12][0]=""; error100_msg_table[12][1]=""; - error100_msg_table[13][0]=""; error100_msg_table[13][1]=""; - - error100_msg_table[14][0]="ERROR_BAD_TEMPLATE"; - //: DEUTSCH "ungültiges Muster" - //: ENGLISH "bad template" - //: FRANCAIS "mauvais schéma" - error100_msg_table[14][1]=GETTEXT("bad template"); - - error100_msg_table[15][0]="ERROR_BAD_NUMBER"; - //: DEUTSCH "ungültige Zahl" - //: ENGLISH "bad number" - //: FRANCAIS "mauvais nombre" - error100_msg_table[15][1]=GETTEXT("bad number"); - - error100_msg_table[16][0]="ERROR_REQUIRED_ARG_MISSING"; - //: DEUTSCH "benötigtes Schlüsselwort nicht vorhanden" - //: ENGLISH "required argument missing" - //: FRANCAIS "mot clé manque" - error100_msg_table[16][1]=GETTEXT("required argument missing"); - - error100_msg_table[17][0]="ERROR_KEY_NEEDS_ARG"; - //: DEUTSCH "kein Wert nach Schlüsselwort vorhanden" - //: ENGLISH "value after keyword missing" - //: FRANCAIS "mot clé sans valeur" - error100_msg_table[17][1]=GETTEXT("value after keyword missing"); - - error100_msg_table[18][0]="ERROR_TOO_MANY_ARGS"; - //: DEUTSCH "falsche Anzahl Argumente" - //: ENGLISH "wrong number of arguments" - //: FRANCAIS "mauvais nombre d'arguments" - error100_msg_table[18][1]=GETTEXT("wrong number of arguments"); - - error100_msg_table[19][0]="ERROR_UNMATCHED_QUOTES"; - //: DEUTSCH "ausstehende Anführungszeichen" - //: ENGLISH "unmatched quotes" - //: FRANCAIS "guillemets non terminés" - error100_msg_table[19][1]=GETTEXT("unmatched quotes"); - - error100_msg_table[20][0]="ERROR_LINE_TOO_LONG"; - //: DEUTSCH "ungültige Zeile oder Zeile zu lang" - //: ENGLISH "argument line invalid or too long" - //: FRANCAIS "ligne est mauvaise ou trop longue" - error100_msg_table[20][1]="argument line invalid or too long"; - - error100_msg_table[21][0]="ERROR_FILE_NOT_OBJECT"; - //: DEUTSCH "Datei ist nicht ausführbar" - //: ENGLISH "file is not executable" - //: FRANCAIS "fichier non exécutable" - error100_msg_table[21][1]=GETTEXT("file is not executable"); - - error100_msg_table[22][0]="ERROR_INVALID_RESIDENT_LIBRARY"; - //: DEUTSCH "ungültige residente Library" - //: ENGLISH "invalid resident library" - //: FRANCAIS "Librarie résidente non valide" - error100_msg_table[22][1]=GETTEXT("invalid resident library"); - - error200_msg_table[0][0]=""; error200_msg_table[0][1]=""; - - error200_msg_table[1][0]="ERROR_NO_DEFAULT_DIR"; - error200_msg_table[1][1]=""; - - error200_msg_table[2][0]="ERROR_OBJECT_IN_USE"; - //: DEUTSCH "Objekt wird schon benutzt" - //: ENGLISH "object is in use" - //: FRANCAIS "l'objet est utilisé" - error200_msg_table[2][1]=GETTEXT("object is in use"); - - error200_msg_table[3][0]="ERROR_OBJECT_EXISTS"; - //: DEUTSCH "Objekt existiert bereits" - //: ENGLISH "object already exists" - //: FRANCAIS "l'objet existe déjà" - error200_msg_table[3][1]=GETTEXT("object already exists"); - - error200_msg_table[4][0]="ERROR_DIR_NOT_FOUND", - //: DEUTSCH "Verzeichnis nicht gefunden" - //: ENGLISH "directory not found" - //: FRANCAIS "répertoire non trouvé" - error200_msg_table[4][1]=GETTEXT("directory not found"); - - error200_msg_table[5][0]="ERROR_OBJECT_NOT_FOUND"; - //: DEUTSCH "Objekt nicht gefunden" - //: ENGLISH "object not found" - //: FRANCAIS "objet non trouvé" - error200_msg_table[5][1]=GETTEXT("object not found"); - - error200_msg_table[6][0]="ERROR_BAD_STREAM_NAME" - //: DEUTSCH "ungültige Fensterbeschreibung" - //: ENGLISH "invalid window description" - //: FRANCAIS "mauvais descripteur de fenêtre" - error200_msg_table[6][1]=GETTEXT("invalid window description"); - - error200_msg_table[7][0]="ERROR_OBJECT_TOO_LARGE"; - //: DEUTSCH "Objekt zu groß" - //: ENGLISH "object too large" - //: FRANCAIS "objet trop grand" - error200_msg_table[7][1]=GETTEXT("object too large"); - - error200_msg_table[8][0]=""; error200_msg_table[8][1]=""; - - error200_msg_table[9][0]="ERROR_ACTION_NOT_KNOWN"; - //: DEUTSCH "unbekannter Pakettyp" # ?? - //: ENGLISH "packet request type unknown" - //: FRANCAIS "Type de paquet inconnu" - error200_msg_table[9][1]=GETTEXT("packet request type unknown"); - - error200_msg_table[10][0]="ERROR_INVALID_COMPONENT_NAME"; - //: DEUTSCH "ungültiger Objektname" - //: ENGLISH "object name invalid" - //: FRANCAIS "nom d'objet incorrect" - error200_msg_table[10][1]=GETTEXT("object name invalid"); - - error200_msg_table[11][0]="ERROR_INVALID_LOCK"; - //: DEUTSCH "ungültiger Objektlock" - //: ENGLISH "invalid object lock" - //: FRANCAIS "«lock» invalide d'un objet" - error200_msg_table[11][1]=GETTEXT("invalid object lock"); - - error200_msg_table[12][0]="ERROR_OBJECT_WRONG_TYPE"; - //: DEUTSCH "Objekt ist nicht von benötigten Typ" - //: ENGLISH "object is not of required type" - //: FRANCAIS "objet de mauvais type" - error200_msg_table[12][1]=GETTEXT("object is not of required type"); - - error200_msg_table[13][0]="ERROR_DISK_NOT_VALIDATED"; - //: DEUTSCH "Datenträger ist nicht validiert" - //: ENGLISH "disk not validated" - //: FRANCAIS "volume non validé" - error200_msg_table[13][1]=GETTEXT("disk not validated"); - - error200_msg_table[14][0]="ERROR_DISK_WRITE_PROTECTED"; - //: DEUTSCH "Datenträger ist schreibgeschützt" - //: ENGLISH "disk is write-protected" - //: FRANCAIS "disquette protégée contre l'écriture" - error200_msg_table[14][1]=GETTEXT("disk is write-protected"); - - error200_msg_table[15][0]="ERROR_RENAME_ACROSS_DEVICES"; - //: DEUTSCH "rename über Laufwerke versucht" - //: ENGLISH "rename across devices attempted" - //: FRANCAIS "«rename» à travers des unités distinctes" - error200_msg_table[15][1]=GETTEXT("rename across devices attempted"); - - error200_msg_table[16][0]="ERROR_DIRECTORY_NOT_EMPTY"; - //: DEUTSCH "Verzeichnis ist nicht leer" - //: ENGLISH "directory not empty" - //: FRANCAIS "répertoire non vide" - error200_msg_table[16][1]=GETTEXT("directory not empty"); - - error200_msg_table[17][0]="ERROR_TOO_MANY_LEVELS"; - //: DEUTSCH "zu viele Verweise" - //: ENGLISH "too many levels" - //: FRANCAIS "trop de niveaux" - error200_msg_table[17][1]=GETTEXT("too many levels"); - - error200_msg_table[18][0]="ERROR_DEVICE_NOT_MOUNTED"; - //: DEUTSCH "Datenträger ist in keinem Laufwerk" - //: ENGLISH "device (or volume) is not mounted" - //: FRANCAIS "l'unité n'est dans aucun lecteur" - error200_msg_table[18][1]=GETTEXT("device (or volume) is not mounted"); - - error200_msg_table[19][0]="ERROR_SEEK_ERROR"; - //: DEUTSCH "seek schlug fehl" - //: ENGLISH "seek failure" - //: FRANCAIS "erreur pendant un déplacement (seek)" - error200_msg_table[19][1]=GETTEXT("seek failure"); - - error200_msg_table[20][0]="ERROR_COMMENT_TOO_BIG"; - //: DEUTSCH "Kommentar ist zu lang" - //: ENGLISH "comment is too long" - //: FRANCAIS "Commentaire trop long" - error200_msg_table[20][1]=GETTEXT("comment is too long"); - - error200_msg_table[21][0]="ERROR_DISK_FULL"; - //: DEUTSCH "Datenträger ist voll" - //: ENGLISH "disk is full" - //: FRANCAIS "support plein" - error200_msg_table[21][1]=GETTEXT("disk is full"); - - error200_msg_table[22][0]="ERROR_DELETE_PROTECTED"; - //: DEUTSCH "Datei ist gegen Löschen geschützt" - //: ENGLISH "object is protected from deletion" - //: FRANCAIS "objet est protégé contre l'effacement" - error200_msg_table[22][1]=GETTEXT("object is protected from deletion"); - - error200_msg_table[23][0]="ERROR_WRITE_PROTECTED"; - //: DEUTSCH "Datei ist schreibgeschützt" - //: ENGLISH "file is write protected" - //: FRANCAIS "fichier protégé contre l'écriture" - error200_msg_table[23][1]=GETTEXT("file is write protected"); - - error200_msg_table[24][0]="ERROR_READ_PROTECTED"; - //: DEUTSCH "Datei ist lesegeschützt" - //: ENGLISH "file is read protected" - //: FRANCAIS "fichier protégé contre la lecture" - error200_msg_table[24][1]=GETTEXT("file is read protected"); - - error200_msg_table[25][0]="ERROR_NOT_A_DOS_DISK"; - //: DEUTSCH "kein gültiger DOS-Datenträger" - //: ENGLISH "not a valid DOS disk" - //: FRANCAIS "disque non DOS" - error200_msg_table[25][1]=GETTEXT("not a valid DOS disk"); - - error200_msg_table[26][0]="ERROR_NO_DISK"; - //: DEUTSCH "kein Datenträger im Laufwerk" - //: ENGLISH "no disk in drive" - //: FRANCAIS "pas de disquette dans le lecteur" - error200_msg_table[26][1]=GETTEXT("no disk in drive"); - - error200_msg_table[27][0]=""; error200_msg_table[27][1]=""; - error200_msg_table[28][0]=""; error200_msg_table[28][1]=""; - error200_msg_table[29][0]=""; error200_msg_table[29][1]=""; - error200_msg_table[30][0]=""; error200_msg_table[30][1]=""; - error200_msg_table[31][0]=""; error200_msg_table[31][1]=""; - - error200_msg_table[32][0]="ERROR_NO_MORE_ENTRIES"; - //: DEUTSCH "keine weiteren Verzeichniseinträge mehr" - //: ENGLISH "no more entries in directory" - //: FRANCAIS "pas plus d'entrées dans le répertoire" - error200_msg_table[32][1]=GETTEXT("no more entries in directory"); - - error200_msg_table[33][0]="ERROR_IS_SOFT_LINK"; - //: DEUTSCH "Objekt ist ein Softlink" - //: ENGLISH "object is soft link" - //: FRANCAIS "l'objet est un «soft link»" - error200_msg_table[33][1]=GETTEXT("object is soft link"); - - error200_msg_table[34][0]="ERROR_OBJECT_LINKED"; - //: DEUTSCH "Objekt ist gelinkt" - //: ENGLISH "object is linked" - //: FRANCAIS "l'objet est lié" - error200_msg_table[34][1]=GETTEXT("object is linked"); - - error200_msg_table[35][0]="ERROR_BAD_HUNK"; - //: DEUTSCH "Datei teilweise nicht ladbar" - //: ENGLISH "bad loadfile hunk" - //: FRANCAIS "fichier pas entièrement chargeable" - error200_msg_table[35][1]=GETTEXT("bad loadfile hunk"); - - error200_msg_table[36][0]="ERROR_NOT_IMPLEMENTED"; - //: DEUTSCH "unimplementierte Funktion" - //: ENGLISH "function not implemented" - //: FRANCAIS "fonction non implémentée" - error200_msg_table[36][1]=GETTEXT("function not implemented"); - - error200_msg_table[37][0]=""; error200_msg_table[37][1]=""; - error200_msg_table[38][0]=""; error200_msg_table[38][1]=""; - error200_msg_table[39][0]=""; error200_msg_table[39][1]=""; - - error200_msg_table[40][0]="ERROR_RECORD_NOT_LOCKED"; - //: DEUTSCH "" - //: ENGLISH "record not locked" - //: FRANCAIS "" - error200_msg_table[40][1]=GETTEXT("record not locked"); - - error200_msg_table[41][0]="ERROR_LOCK_COLLISION"; - //: DEUTSCH "" - //: ENGLISH "record lock collision" - //: FRANCAIS "" - error200_msg_table[41][1]=GETTEXT("record lock collision"); - - error200_msg_table[42][0]="ERROR_LOCK_TIMEOUT"; - //: DEUTSCH "" - //: ENGLISH "record lock timeout" - //: FRANCAIS "" - error200_msg_table[42][1]=GETTEXT("record lock timeout"); - - error200_msg_table[43][0]="ERROR_UNLOCK_ERROR"; - //: DEUTSCH "" - //: ENGLISH "record unlock error" - //: FRANCAIS "" - error200_msg_table[43][1]=GETTEXT("record unlock error"); - - error300_msg_table[0][0]=""; error300_msg_table[0][1]=""; - error301_msg_table[1][0]=""; error301_msg_table[1][1]=""; - error302_msg_table[2][0]=""; error302_msg_table[2][1]=""; - - error300_msg_table[3][0]="ERROR_BUFFER_OVERFLOW"; - //: DEUTSCH "Puffer-Überlauf" - //: ENGLISH "buffer overflow" - //: FRANCAIS "débordement de tampon" - error300_msg_table[3][1]=GETTEXT("buffer overflow"); - - error300_msg_table[4][0]="ERROR_BREAK"; - //: DEUTSCH "Unterbrechung" - //: ENGLISH "break" - //: FRANCAIS "interruption" - error300_msg_table[4][1]=GETTEXT("break"); - - error300_msg_table[5][0]="ERROR_NOT_EXECUTABLE"; - //: DEUTSCH "Datei ist nicht ausführbar" - //: ENGLISH "file not executable" - //: FRANCAIS "fichier non exécutable" - error300_msg_table[5][1]=GETTEXT("file not executable"); - if (errcode == 0) { errorname = ""; --- 680,683 ---- *************** *** 699,704 **** } } ! # Fehlercode löschen (fürs nächste Mal): ! ((struct Process *)FindTask(NULL))->pr_Result2 = 0L; end_error(args_end_pointer STACKop (4+DYNBIND_SIZE)); # Fehlermeldung beenden } --- 709,713 ---- } } ! SetIoErr(0L); # Fehlercode löschen (fürs nächste Mal): end_error(args_end_pointer STACKop (4+DYNBIND_SIZE)); # Fehlermeldung beenden } *************** *** 1042,1045 **** --- 1051,1055 ---- end_error(args_end_pointer STACKop (4+DYNBIND_SIZE)); # Fehlermeldung beenden } + # Ausgabe eines Fehlers, direkt übers Betriebssystem # errno_out(errorcode); *************** *** 1051,1066 **** #endif - nonreturning_function(global, OS_error_debug, (const char *,int)); - global void OS_error_debug (const char *filename,int lineno); - global void OS_error_debug(filename,lineno) - var const char *filename; - var int lineno; - { - asciz_out(CRLFstring "filename: "); asciz_out(filename); - asciz_out(CRLFstring "line: "); dez_out(lineno); - asciz_out(CRLFstring); - OS_error_(); - } - #if defined(UNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS) || defined(WIN32_DOS) || defined(WIN32_UNIX) --- 1061,1064 ---- *************** *** 1993,1997 **** return 0; } ! global void OS_error_ () { var reg1 uintC errcode = errno; # positive Fehlernummer --- 1991,1995 ---- return 0; } ! global void OS_error_ () { var reg1 uintC errcode = errno; # positive Fehlernummer *************** *** 2065,2068 **** --- 2063,2078 ---- #endif # UNIX || EMUNIX || WATCOM || RISCOS + + nonreturning_function(global, OS_error_debug, (const char *,int)); + global void OS_error_debug (const char *filename,int lineno); + global void OS_error_debug(filename,lineno) + var const char *filename; + var int lineno; + { + asciz_out(CRLFstring "filename: "); asciz_out(filename); + asciz_out(CRLFstring "line: "); dez_out(lineno); + asciz_out(CRLFstring); + OS_error_(); + } LISPFUN(error,1,0,rest,nokey,0,NIL) Only in src/: eval.d Only in src/: ffloat.d Only in src/: floatpri.fas Only in src/: floatpri.lib Only in src/: floatpri.lsp Only in src/: flo_konv.d Only in src/: flo_rest.d diff -c2 src.orig/foreign.d src/foreign.d *** src.orig/foreign.d Mon Apr 15 16:29:48 1996 --- src/foreign.d Fri Jul 26 21:35:12 1996 *************** *** 545,550 **** #else # defined(AMIGAOS) # No malloc() is available. Disable malloc() and free() altogether. ! nonreturning_function(local, fehler_malloc_free, (void)); ! local void fehler_malloc_free() { //: DEUTSCH ":MALLOC-FREE ist unter AMIGAOS nicht verfügbar." --- 545,550 ---- #else # defined(AMIGAOS) # No malloc() is available. Disable malloc() and free() altogether. ! nonreturning_function(global, fehler_malloc_free, (void)); ! global void fehler_malloc_free() { //: DEUTSCH ":MALLOC-FREE ist unter AMIGAOS nicht verfügbar." *************** *** 553,558 **** fehler(error, GETTEXT(":MALLOC-FREE is not available under AMIGAOS.")); } ! #define malloc(amount) (fehler_malloc_free(), 0) ! #define free(pointer) (fehler_malloc_free(), 0) #define xmalloc(size) malloc(size) #endif --- 553,558 ---- fehler(error, GETTEXT(":MALLOC-FREE is not available under AMIGAOS.")); } ! #define malloc(amount) (fehler_malloc_free(), NULL) ! #define free(pointer) fehler_malloc_free() #define xmalloc(size) malloc(size) #endif *************** *** 2634,2639 **** # do_av_arg(flags,arg_fvd,&alist,arg_address,arg_size,arg_alignment); local void do_av_arg (uintWL flags, object arg_fvd, av_alist * alist, void* arg_address, unsigned long arg_size, unsigned long arg_alignment); ! #ifdef AMIGA ! local int AV_ARG_REGNUM; # number of register where the argument is to be passed #endif local void do_av_arg(flags,arg_fvd,alist,arg_address,arg_size,arg_alignment) --- 2634,2639 ---- # do_av_arg(flags,arg_fvd,&alist,arg_address,arg_size,arg_alignment); local void do_av_arg (uintWL flags, object arg_fvd, av_alist * alist, void* arg_address, unsigned long arg_size, unsigned long arg_alignment); ! #ifdef AMIGAOS ! local sintWL AV_ARG_REGNUM; # number of register where the argument is to be passed #endif local void do_av_arg(flags,arg_fvd,alist,arg_address,arg_size,arg_alignment) *************** *** 2849,2852 **** --- 2849,2857 ---- } } + #ifdef AMIGAOS + # set register a6 as for a library call, even if not used + # library pointer has already been validated through Fpointer_value() above + alist.regargs[8+7-1] = (uintP)TheFpointer(TheFaddress(TheFfunction(ffun)->ff_address)->fa_base)->fp_pointer; + #endif {var reg4 uintL result_count = 0; typedef struct { void* address; } result_descr; # fvd is pushed onto the STACK *************** *** 2901,2905 **** } # Call av_xxx: ! #ifdef AMIGA AV_ARG_REGNUM = (int)(arg_flags >> 8) - 1; #endif --- 2906,2910 ---- } # Call av_xxx: ! #ifdef AMIGAOS AV_ARG_REGNUM = (int)(arg_flags >> 8) - 1; #endif *************** *** 2922,2926 **** } # Call av_xxx: ! #ifdef AMIGA AV_ARG_REGNUM = (int)(arg_flags >> 8) - 1; #endif --- 2927,2931 ---- } # Call av_xxx: ! #ifdef AMIGAOS AV_ARG_REGNUM = (int)(arg_flags >> 8) - 1; #endif *************** *** 3410,3422 **** while (consp(alist)) { if (equal(name,Car(Car(alist)))) ! { var reg3 object lib = Cdr(Car(alist)); if (!fp_validp(TheFpointer(lib))) # Library already existed in a previous Lisp session. # Update the address, and make it valid. ! { var reg4 struct Library * libaddr = open_library(name,v); TheFpointer(lib)->fp_pointer = libaddr; mark_fp_valid(TheFpointer(lib)); } ! value1 = lib; goto done; } --- 3415,3428 ---- while (consp(alist)) { if (equal(name,Car(Car(alist)))) ! { var reg4 object address = Cdr(Car(alist)); ! var reg3 object lib = TheFaddress(address)->fa_base; if (!fp_validp(TheFpointer(lib))) # Library already existed in a previous Lisp session. # Update the address, and make it valid. ! { var reg5 struct Library * libaddr = open_library(name,v); TheFpointer(lib)->fp_pointer = libaddr; mark_fp_valid(TheFpointer(lib)); } ! value1 = address; goto done; } *************** *** 3425,3433 **** # Pre-allocate room: pushSTACK(allocate_cons()); pushSTACK(allocate_cons()); ! pushSTACK(allocate_fpointer()); # Open the library: ! { var reg5 struct Library * libaddr = open_library(STACK_(1+3),v); var reg4 object lib = popSTACK(); ! TheFpointer(lib)->fp_pointer = libaddr; value1 = lib; {var reg1 object acons = popSTACK(); --- 3431,3442 ---- # Pre-allocate room: pushSTACK(allocate_cons()); pushSTACK(allocate_cons()); ! pushSTACK(allocate_fpointer((void*)0)); ! pushSTACK(allocate_faddress()); # Open the library: ! { var reg5 struct Library * libaddr = open_library(STACK_(1+4),v); var reg4 object lib = popSTACK(); ! TheFpointer(STACK_0)->fp_pointer = libaddr; ! TheFaddress(lib)->fa_base = popSTACK(); ! TheFaddress(lib)->fa_offset = 0; value1 = lib; {var reg1 object acons = popSTACK(); *************** *** 3452,3456 **** { var reg2 object acons = Car(l); l = Cdr(l); ! if (eq(Cdr(acons),obj)) { var reg4 struct Library * libaddr = open_library(Car(acons),0); # version ?? TheFpointer(obj)->fp_pointer = libaddr; --- 3461,3465 ---- { var reg2 object acons = Car(l); l = Cdr(l); ! if (eq(TheFaddress(Cdr(acons))->fa_base,obj)) { var reg4 struct Library * libaddr = open_library(Car(acons),0); # version ?? TheFpointer(obj)->fp_pointer = libaddr; *************** *** 3461,3465 **** } ! # (FFI::FOREIGN-LIBRARY-VARIABLE name library offset c-type) # returns a foreign variable. LISPFUNN(foreign_library_variable,4) --- 3470,3474 ---- } ! # (FFI::FOREIGN-ADDRESS-VARIABLE name library offset c-type) # returns a foreign variable. LISPFUNN(foreign_library_variable,4) *************** *** 3466,3476 **** { if (!mstringp(STACK_3)) { fehler_string(STACK_3); } STACK_3 = coerce_ss(STACK_3); ! if (!fpointerp(STACK_2)) { pushSTACK(STACK_2); pushSTACK(TheSubr(subr_self)->name); ! //: DEUTSCH "~: ~ ist keine Bibliothek." ! //: ENGLISH "~: ~ is not a library" ! //: FRANCAIS "~ : ~ n'est pas une bibliothèque." ! fehler(error, GETTEXT("~: ~ is not a library")); } check_sint32(STACK_1); --- 3475,3485 ---- { if (!mstringp(STACK_3)) { fehler_string(STACK_3); } STACK_3 = coerce_ss(STACK_3); ! if (!faddressp(STACK_2)) { pushSTACK(STACK_2); pushSTACK(TheSubr(subr_self)->name); ! //: DEUTSCH "~: Argument ist keine Foreign-Adresse: ~" ! //: ENGLISH "~: argument is not a foreign address: ~" ! //: FRANCAIS "~ : l'argument n'est pas une adresse étrangère : ~." ! fehler(error, GETTEXT("~: argument is not a foreign address: ~")); } check_sint32(STACK_1); *************** *** 3478,3482 **** {var reg3 uintL size = data_size; var reg2 uintL alignment = data_alignment; ! pushSTACK(make_faddress(STACK_2,(sintP)I_to_sint32(STACK_1))); { var reg1 object fvar = allocate_fvariable(); TheFvariable(fvar)->fv_name = STACK_(3+1); --- 3487,3493 ---- {var reg3 uintL size = data_size; var reg2 uintL alignment = data_alignment; ! pushSTACK(make_faddress(TheFaddress(STACK_2)->fa_base, ! TheFaddress(STACK_2)->fa_offset ! + (sintP)I_to_sint32(STACK_1))); { var reg1 object fvar = allocate_fvariable(); TheFvariable(fvar)->fv_name = STACK_(3+1); *************** *** 3500,3504 **** { if (!mstringp(STACK_3)) { fehler_string(STACK_3); } STACK_3 = coerce_ss(STACK_3); ! if (!fpointerp(STACK_2)) { pushSTACK(STACK_2); pushSTACK(TheSubr(subr_self)->name); --- 3511,3515 ---- { if (!mstringp(STACK_3)) { fehler_string(STACK_3); } STACK_3 = coerce_ss(STACK_3); ! if (!faddressp(STACK_2)) # TODO? search in O(foreign_libraries) { pushSTACK(STACK_2); pushSTACK(TheSubr(subr_self)->name); *************** *** 3526,3530 **** } } ! pushSTACK(make_faddress(STACK_2,(sintP)I_to_sint32(STACK_1))); { var reg1 object ffun = allocate_ffunction(); var reg2 object fvd = STACK_(0+1); --- 3537,3543 ---- } } ! pushSTACK(make_faddress(TheFaddress(STACK_2)->fa_base, ! TheFaddress(STACK_2)->fa_offset ! + (sintP)I_to_sint32(STACK_1))); { var reg1 object ffun = allocate_ffunction(); var reg2 object fvd = STACK_(0+1); *************** *** 3568,3572 **** while (consp(alist)) { var reg4 object acons = Car(alist); ! var reg3 object obj = Cdr(acons); if (fp_validp(TheFpointer(obj))) { var reg2 struct Library * libaddr = (struct Library *)(TheFpointer(obj)->fp_pointer); --- 3581,3585 ---- while (consp(alist)) { var reg4 object acons = Car(alist); ! var reg3 object obj = TheFaddress(Cdr(acons))->fa_base; if (fp_validp(TheFpointer(obj))) { var reg2 struct Library * libaddr = (struct Library *)(TheFpointer(obj)->fp_pointer); Only in src/: foreign1.fas Only in src/: foreign1.lib diff -c2 src.orig/foreign1.lsp src/foreign1.lsp *** src.orig/foreign1.lsp Mon Apr 15 16:29:50 1996 --- src/foreign1.lsp Sat Jul 27 01:28:43 1996 *************** *** 11,14 **** --- 11,15 ---- def-c-enum def-c-struct element deref slot cast typeof sizeof bitsizeof validp + #+AMIGA def-lib-call-out ) ) *************** *** 98,102 **** ) ) ! #+AMIGAOS (defconstant *registers* '#(:D0 :D1 :D2 :D3 :D4 :D5 :D6 :D7 :A0 :A1 :A2 :A3 :A4 :A5 :A6) --- 99,103 ---- ) ) ! #+AMIGA (defconstant *registers* '#(:D0 :D1 :D2 :D3 :D4 :D5 :D6 :D7 :A0 :A1 :A2 :A3 :A4 :A5 :A6) *************** *** 379,383 **** (unless (and (listp argspec) (symbolp (first argspec)) ! (<= 2 (length argspec) #-AMIGAOS 4 #+AMIGAOS 5) ) (error --- 380,384 ---- (unless (and (listp argspec) (symbolp (first argspec)) ! (<= 2 (length argspec) #-AMIGA 4 #+AMIGA 5) ) (error *************** *** 413,417 **** (:MALLOC-FREE ff-flag-malloc-free) ) ! #+AMIGAOS (if (cddddr argspec) (ash (1+ (position (fifth argspec) *registers*)) 8) --- 414,418 ---- (:MALLOC-FREE ff-flag-malloc-free) ) ! #+AMIGA (if (cddddr argspec) (ash (1+ (position (fifth argspec) *registers*)) 8) *************** *** 551,555 **** (t ':NONE) ) ! #+AMIGAOS ,@(let ((h (logand (ash argflags -8) #xF))) (if (not (zerop h)) --- 552,556 ---- (t ':NONE) ) ! #+AMIGA ,@(let ((h (logand (ash argflags -8) #xF))) (if (not (zerop h)) *************** *** 917,920 **** --- 918,938 ---- (push (list c-name (parse-c-function alist whole)) *function-list*) ) ) + + #+AMIGA + (defmacro DEF-LIB-CALL-OUT (&whole whole name library &rest options) + (check-symbol whole) + (let* ((alist (parse-options options '(:name :offset :arguments :return-type) whole)) + (c-name (foreign-name name (assoc ':name alist))) + (offset (second (assoc ':offset alist)))) + `(LET () + (SYSTEM::REMOVE-OLD-DEFINITIONS ',name) + (EVAL-WHEN (COMPILE) (COMPILER::C-DEFUN ',name)) + (SYSTEM::%PUTD ',name + (FFI::FOREIGN-LIBRARY-FUNCTION ',c-name + (FFI::FOREIGN-LIBRARY ',library) + ',offset + (PARSE-C-FUNCTION ',(remove (assoc ':name alist) alist) ',whole))) + ',name + ) ) ) (defmacro DEF-C-CALL-IN (name &rest options) Only in src/: format.fas Only in src/: format.lib diff -c2 src.orig/format.lsp src/format.lsp *** src.orig/format.lsp Mon Apr 15 16:29:50 1996 --- src/format.lsp Wed Aug 07 01:05:51 1996 *************** *** 1470,1474 **** (progn (when (char-bit arg ':HYPER) ! (write-string #L{ DEUTSCH "Ziffernblock-" --- 1470,1474 ---- (progn (when (char-bit arg ':HYPER) ! (write-string #L{ DEUTSCH "Ziffernblock-" *************** *** 2790,2794 **** (if (and (consp new-forms) (stringp (car new-forms)) (stringp form)) (setf (car new-forms) ! (concatenate 'string form (car new-forms)) ) (push form new-forms) --- 2790,2794 ---- (if (and (consp new-forms) (stringp (car new-forms)) (stringp form)) (setf (car new-forms) ! (string-concat form (car new-forms)) ) (push form new-forms) Only in src/: fsubr.d Only in src/: genclisph.d Only in src/: gstream.fas Only in src/: gstream.lib Only in src/: gstream.lsp Only in src/: hashtabl.d Only in src/: init-small.fas Only in src/: init.fas Only in src/: init.lib diff -c2 src.orig/init.lsp src/init.lsp *** src.orig/init.lsp Mon Apr 15 16:29:56 1996 --- src/init.lsp Mon Jun 17 20:58:12 1996 *************** *** 1804,1808 **** :pathname filename #L{ ! DEUTSCH "Ein Datei mit Namen ~A gibt es nicht." ENGLISH "A file with name ~A does not exist" FRANCAIS "Il n'existe pas de fichier de nom ~A." --- 1804,1808 ---- :pathname filename #L{ ! DEUTSCH "Eine Datei mit Namen ~A gibt es nicht." ENGLISH "A file with name ~A does not exist" FRANCAIS "Il n'existe pas de fichier de nom ~A." *************** *** 2236,2239 **** --- 2236,2244 ---- #+FFI ; when (find-package "FFI") (LOAD "foreign1") ;; foreign function interface, optional + + #+AMIGA + (when (find-symbol "%LIBCALL" "SYS") + (LOAD "affi1") ;; einfaches FFI, optional + ) (when (or #+AMIGA t (find-package "SCREEN")) Only in src/: int2adic.d Only in src/: intbyte.d Only in src/: intcomp.d Only in src/: intdiv.d diff -c2 src.orig/intelem.d src/intelem.d *** src.orig/intelem.d Mon Apr 15 16:30:00 1996 --- src/intelem.d Sun Jul 21 20:04:32 1996 *************** *** 278,282 **** } } ! #if defined(HAVE_FFI) && defined(HAVE_LONGLONG) # Wandelt Integer >=0 in Unsigned Quadword um. --- 278,282 ---- } } ! #if (defined(HAVE_FFI) || defined(HAVE_AFFI)) && defined(HAVE_LONGLONG) # Wandelt Integer >=0 in Unsigned Quadword um. *************** *** 355,358 **** --- 355,361 ---- fehler(type_error, GETTEXT("not a 64-bit integer: ~")); } } + + #endif + #if defined(HAVE_FFI) && defined(HAVE_LONGLONG) # Wandelt Integer in Signed Quadword um. Only in src/: intgcd.d Only in src/: intlog.d Only in src/: intmal.d Only in src/: intplus.d Only in src/: intprint.d Only in src/: intread.d Only in src/: intsqrt.d Only in src/: io.d Only in src/: lfloat.d Only in src/: lisparit.d Only in src/: lisparit0.d Only in src/: lisparit1.d Only in src/: lisparit2.d diff -c2 src.orig/lispbibl.d src/lispbibl.d *** src.orig/lispbibl.d Thu May 23 19:30:46 1996 --- src/lispbibl.d Sun Jul 21 21:28:00 1996 *************** *** 468,472 **** #endif #else ! #define GETTEXT(str) (DEUTSCH ? DEUTSCH_MSG : ENGLISH ? ENGLISH_MSG : FRANCAIS ? FRANCAIS_MSG : str) #endif #endif --- 468,473 ---- #endif #else ! # define GETTEXT(str) (DEUTSCH ? DEUTSCH_MSG : ENGLISH ? ENGLISH_MSG : FRANCAIS ? FRANCAIS_MSG : str) ! #define GETTEXT(str) (DEUTSCH ? DEUTSCH_MSG : FRANCAIS ? FRANCAIS_MSG : ENGLISH_MSG) #endif #endif *************** *** 1535,1543 **** #ifdef AMIGAOS - #ifdef GNU - # Expandiere alle Betriebssystem-Aufrufe inline, mit Markus Wild inlines.h - #define GNU_INLINES - #endif - #include "amiga.c" --- 1536,1539 ---- *************** *** 1739,1743 **** # Ob das Betriebssystem ein Environment verwaltet, das Strings zu Strings # assoziiert: ! #if defined(UNIX) || defined(MSDOS) || defined(RISCOS) || defined(WIN32_UNIX) #define HAVE_ENVIRONMENT #endif --- 1735,1739 ---- # Ob das Betriebssystem ein Environment verwaltet, das Strings zu Strings # assoziiert: ! #if defined(UNIX) || defined(MSDOS) || defined(AMIGAOS) || defined(RISCOS) || defined(WIN32_UNIX) #define HAVE_ENVIRONMENT #endif *************** *** 6639,6643 **** #ifndef LANGUAGE_STATIC # Sprache, in der mit dem Benutzer kommuniziert wird: ! extern uintL language; #define language_english 0 #define language_deutsch 1 --- 6635,6639 ---- #ifndef LANGUAGE_STATIC # Sprache, in der mit dem Benutzer kommuniziert wird: ! extern uintC language; #define language_english 0 #define language_deutsch 1 *************** *** 7460,7464 **** ! # ####################### MODBIBL zu EVAL.D ############################## # # Anzahl der externen Module: --- 7456,7460 ---- ! # ###################### MODBIBL zu MODULES.D ############################ # # Anzahl der externen Module: *************** *** 9704,9710 **** #ifdef AMIGAOS # Behandlung von AMIGAOS-Fehlern ! # OS_error(); # > IoErr(): Fehlercode ! nonreturning_function(extern, OS_error, (void)); # wird verwendet von SPVW, STREAM, PATHNAME #endif --- 9700,9706 ---- #ifdef AMIGAOS # Behandlung von AMIGAOS-Fehlern ! # OS_error_(); # > IoErr(): Fehlercode ! nonreturning_function(extern, OS_error_, (void)); # wird verwendet von SPVW, STREAM, PATHNAME #endif *************** *** 9716,9720 **** # wird verwendet von SPVW, STREAM, PATHNAME, GRAPH #endif ! #if defined(UNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS) || defined(WIN32_UNIX) || defined(WIN32_DOS) # Initialisierung der Fehlertabelle: extern int init_errormsg_table (void); --- 9712,9716 ---- # wird verwendet von SPVW, STREAM, PATHNAME, GRAPH #endif ! #if defined(UNIX) || defined(EMUNIX) || defined(AMIGAOS) || defined(WATCOM) || defined(RISCOS) || defined(WIN32_UNIX) || defined(WIN32_DOS) # Initialisierung der Fehlertabelle: extern int init_errormsg_table (void); *************** *** 10407,10411 **** # wird verwendet von STDWIN ! #if defined(HAVE_FFI) && defined(HAVE_LONGLONG) # Wandelt Integer >=0 in Unsigned Quadword um. --- 10403,10407 ---- # wird verwendet von STDWIN ! #if (defined(HAVE_FFI) || defined(HAVE_AFFI)) && defined(HAVE_LONGLONG) # Wandelt Integer >=0 in Unsigned Quadword um. *************** *** 10414,10418 **** # < ergebnis: der Wert des Integer als Unsigned Quadword. extern uint64 I_to_UQ (object obj); ! # wird verwendet von FOREIGN, vom FFI # Wandelt Integer in Signed Quadword um. --- 10410,10417 ---- # < ergebnis: der Wert des Integer als Unsigned Quadword. extern uint64 I_to_UQ (object obj); ! # wird verwendet von AFFI, FOREIGN, vom FFI ! ! #endif ! #if defined(HAVE_FFI) && defined(HAVE_LONGLONG) # Wandelt Integer in Signed Quadword um. *************** *** 10425,10429 **** #endif ! #ifdef HAVE_FFI # Wandelt ein Integer in ein C-Integer gegebenen Typs um. # I_to_xintyy(obj) setzt voraus, daß xintyy_p(obj) schon abgeprüft wurde. --- 10424,10428 ---- #endif ! #if defined(HAVE_FFI) || defined(HAVE_AFFI) # Wandelt ein Integer in ein C-Integer gegebenen Typs um. # I_to_xintyy(obj) setzt voraus, daß xintyy_p(obj) schon abgeprüft wurde. *************** *** 10458,10462 **** #define I_to_slong I_to_sint64 #endif ! # wird verwendet vom FFI #endif --- 10457,10461 ---- #define I_to_slong I_to_sint64 #endif ! # wird verwendet von AFFI, vom FFI #endif *************** *** 10724,10736 **** extern void switch_text_mode (void); - #endif - - # ######################################################################### # - - #if defined(AMIGAOS) && defined(GNU_INLINES) && defined(GNU_INLINES_LATE) - # Inline-Deklarationen der Betriebssystem-Funktionen nach Markus Wild - # (dürfen erst nach globalen Register-Deklarationen kommen!) - #include <inline/exec.h> - #include <inline/dos.h> #endif --- 10723,10726 ---- Only in src/: list.d Only in src/: loop.fas Only in src/: loop.lib Only in src/: loop.lsp Only in src/: macros1.fas Only in src/: macros1.lib Only in src/: macros1.lsp Only in src/: macros2.fas Only in src/: macros2.lib Only in src/: macros2.lsp Only in src/: macros3.fas Only in src/: macros3.lib Only in src/: macros3.lsp Only in src/: main.d Only in src/: misc.d Only in src/: modules.d Only in src/: modules.h Only in src/: noreadline.d Only in src/: package.d diff -c2 src.orig/pathname.d src/pathname.d *** src.orig/pathname.d Thu May 23 19:19:50 1996 --- src/pathname.d Thu Aug 01 08:42:41 1996 *************** *** 945,949 **** //: ENGLISH "~: argument should be a string, symbol, file stream or pathname, not ~" //: FRANCAIS "~ : L'argument doit être une chaîne, un symbole, un «stream» de fichier ou un «pathname» et non ~" ! fehler(error, GETTEXT("~: argument should be a string, symbol, file stream or pathname, not ~")); } --- 945,949 ---- //: ENGLISH "~: argument should be a string, symbol, file stream or pathname, not ~" //: FRANCAIS "~ : L'argument doit être une chaîne, un symbole, un «stream» de fichier ou un «pathname» et non ~" ! fehler(error, GETTEXT("~: argument should be a string, symbol, file stream or pathname, not ~")); } *************** *** 6149,6153 **** local object assure_dir_exists(tolerantp) var reg5 boolean tolerantp; ! { return assure_dir_exists(tolerantp,FALSE); } --- 6149,6153 ---- local object assure_dir_exists(tolerantp) var reg5 boolean tolerantp; ! { return assure_dir_exists_(tolerantp,FALSE); } *************** *** 8819,8823 **** # Stackaufbau: ..., pathname, dir_namestring, direntry. # Feststellen, ob es ein Directory oder ein File ist: ! if (fibptr->fib_DirEntryType > 0) # Ist es ein Directory? # Eintrag ist ein Directory. { if (recursively) # alle rekursiven Subdirectories gewünscht? --- 8819,8824 ---- # Stackaufbau: ..., pathname, dir_namestring, direntry. # Feststellen, ob es ein Directory oder ein File ist: ! if ((fibptr->fib_DirEntryType > 0) ! && (fibptr->fib_DirEntryType != ST_SOFTLINK)) # Ist es ein Directory? # Eintrag ist ein Directory. { if (recursively) # alle rekursiven Subdirectories gewünscht? Only in src/: places.fas Only in src/: places.lib Only in src/: places.lsp Only in src/: predtype.d Only in src/: pseudofun.d Only in src/: rational.d Only in src/: realelem.d Only in src/: realrand.d Only in src/: realtran.d Only in src/: record.d diff -c2 src.orig/rexx.d src/rexx.d *** src.orig/rexx.d Mon Apr 15 16:30:32 1996 --- src/rexx.d Sun Jul 21 21:02:30 1996 *************** *** 9,12 **** --- 9,16 ---- #include "amiga2.c" + # ARexx 'library base' pointer: + # (Muß global sichtbar sein und diesen Namen tragen, damit's der Linker findet!) + global struct RxsLib * RexxSysBase = NULL; + #ifdef DEBUG_REXX *************** *** 412,415 **** --- 416,420 ---- # Die Message foreign ist nun beantwortet. O(rexx_inmsg_list) = deleteq(O(rexx_inmsg_list),foreign); + mark_fp_invalid(TheFpointer(foreign)); # prohibit further use debug_asciz_out(CRLFstring); } *************** *** 457,464 **** value1 = NIL; mv_count=0; }} - - # ARexx 'library base' pointer: - # (Muß global sichtbar sein und diesen Namen tragen, damit's der Linker findet!) - global struct RxsLib * RexxSysBase = NULL; # Initialisiert das REXX-Interface. --- 462,465 ---- Only in src/: rexx1.fas Only in src/: rexx1.lib diff -c2 src.orig/rexx1.lsp src/rexx1.lsp *** src.orig/rexx1.lsp Mon Apr 15 16:30:32 1996 --- src/rexx1.lsp Thu Jun 13 21:59:49 1996 *************** *** 1,4 **** ;;;; Rexx Funktionen für CLISP ! ;;;; Jörg Höhle 5.7.1994 (in-package "LISP") --- 1,4 ---- ;;;; Rexx Funktionen für CLISP ! ;;;; Jörg Höhle 13.6.1996 (in-package "LISP") *************** *** 44,49 **** ;; unbearbeiteten Messages und ihrer Antworten (Listen (Code String); ;; NIL für noch unbeantwortete Messages). Beim Abschicken einer Message ! ;; bekommen wir ein "handle" als Erkennungszeichen (diese werden ! ;; mit EQUAL verglichen). (defvar *rexx-outmsg-list* '()) --- 44,49 ---- ;; unbearbeiteten Messages und ihrer Antworten (Listen (Code String); ;; NIL für noch unbeantwortete Messages). Beim Abschicken einer Message ! ;; bekommen wir ein "handle" (FOREIGN-POINTER) als Erkennungszeichen ! ;; (diese werden mit EQUALP verglichen). (defvar *rexx-outmsg-list* '()) *************** *** 53,57 **** ) (defun rexx-find-index (handle) ! (assoc handle *rexx-outmsg-list* :test #'equal) ) (defun rexx-delete-entry (acons) --- 53,57 ---- ) (defun rexx-find-index (handle) ! (assoc handle *rexx-outmsg-list* :test #'equalp) ) (defun rexx-delete-entry (acons) *************** *** 109,113 **** (when index (setf (cdr index) (rest event))) ; Antwort abspeichern ) ! (when (equal (first event) wait-for) (return-from rexx-loop (rest event)) ; evtl. Schleife beenden )) --- 109,113 ---- (when index (setf (cdr index) (rest event))) ; Antwort abspeichern ) ! (when (equalp (first event) wait-for) (return-from rexx-loop (rest event)) ; evtl. Schleife beenden )) Only in src/: screen.fas Only in src/: screen.lib diff -c2 src.orig/screen.lsp src/screen.lsp *** src.orig/screen.lsp Mon Apr 15 16:30:34 1996 --- src/screen.lsp Tue Jul 23 09:38:56 1996 *************** *** 41,45 **** ;;;; SCREEN-Package for Amiga ! ;;;; Jörg Höhle, 17.1.1995 #+AMIGA (use-package "CLOS") --- 41,45 ---- ;;;; SCREEN-Package for Amiga ! ;;;; Jörg Höhle, 23.7.1996 #+AMIGA (use-package "CLOS") *************** *** 62,69 **** ;; The class of all data present in SCREEN's generic streams. ! (defclass screen-controller (generic-stream-controller) ()) ! ! ; Most stream functions are aliased to the following stream: ! (defgeneric controller-stream (controller)) ; The screen's mode: either T (raw) or NIL (line editing enabled) --- 62,69 ---- ;; The class of all data present in SCREEN's generic streams. ! (defclass screen-controller (generic-stream-controller) ! ((stream :reader controller-stream ! :type stream ! ) )) ; The screen's mode: either T (raw) or NIL (line editing enabled) *************** *** 75,90 **** ; terminal-controller generic streams refer to *terminal-io*. ! (defclass terminal-controller (screen-controller) ()) ! (defmethod controller-stream ((controller terminal-controller)) ! *terminal-io* ! ) ! ; The terminal's mode is cached in stream.d, no need to cache it here. ; window-controller generic streams refer to a special device stream. (defclass window-controller (screen-controller) ! ((stream :reader controller-stream ! :type stream ! :initarg :stream ! ) (mode :accessor controller-mode :initform 'unknown ; the initial mode is unknown --- 75,86 ---- ; terminal-controller generic streams refer to *terminal-io*. ! (defclass terminal-controller (screen-controller) ! ((stream :initform *terminal-io*) ; cache so that *terminal-io* can be rebound ! ; The terminal's mode is cached in stream.d, no need to cache it here. ! ) ) ; window-controller generic streams refer to a special device stream. (defclass window-controller (screen-controller) ! ((stream :initarg :stream) (mode :accessor controller-mode :initform 'unknown ; the initial mode is unknown *************** *** 136,140 **** (defmethod generic-stream-read-char ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; need to switch to cooked mode (read-char (controller-stream controller)) ) --- 132,136 ---- (defmethod generic-stream-read-char ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; want to switch to cooked mode (read-char (controller-stream controller)) ) *************** *** 141,145 **** (defmethod generic-stream-listen ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; need to switch to cooked mode (if (listen (controller-stream controller)) 0 ; something available --- 137,141 ---- (defmethod generic-stream-listen ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; want to switch to cooked mode (if (listen (controller-stream controller)) 0 ; something available *************** *** 148,154 **** (defmethod generic-stream-clear-input ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; need to switch to cooked mode (clear-input (controller-stream controller)) ! t ) --- 144,150 ---- (defmethod generic-stream-clear-input ((controller screen-controller)) ! (generic-raw-mode controller nil) ;; want to switch to cooked mode (clear-input (controller-stream controller)) ! T ) *************** *** 184,188 **** ) ! ; returns a list of all characters immediately available on stream (defun stream-chars (stream) (let ((res '())) --- 180,184 ---- ) ! ; Return a list of all characters immediately available on stream (defun stream-chars (stream) (let ((res '())) *************** *** 332,345 **** - ;; Read characters in raw mode - (defun read-raw-char (stream) - (raw-mode stream t) - (setq stream (controller-stream (generic-stream-controller stream))) - (read-char stream) - ) - ;; This function does a simple mapping from CSI-sequences as reported ;; by the Amiga keyboard to characters with HYPER (even SUPER or CONTROL) bit ! ;; set. ;; key codes shift character ;; f1 CSI0~ CSI10~ #\f1, #\s-f1 --- 328,334 ---- ;; This function does a simple mapping from CSI-sequences as reported ;; by the Amiga keyboard to characters with HYPER (even SUPER or CONTROL) bit ! ;; set. Furthermore, most codes between 1 and 26 get the CONTROL bit set. ;; key codes shift character ;; f1 CSI0~ CSI10~ #\f1, #\s-f1 *************** *** 351,359 **** ;; Right CSIC CSI @ #\Right, #\S-Right (defun read-keyboard-char (stream) ! (let ((c (read-raw-char stream))) (if (char= c '#\CSI) (let ((chars '()) c) (loop ! (setq c (read-raw-char stream)) (unless (char<= #\Space c #\?) (return)) (push c chars) --- 340,352 ---- ;; Right CSIC CSI @ #\Right, #\S-Right (defun read-keyboard-char (stream) ! ; In order to minimize mode switches, switch once then read from low-level stream ! (raw-mode stream t) ! (when (generic-stream-p stream) ! (setq stream (controller-stream (generic-stream-controller stream)))) ! (let ((c (read-char stream))) (if (char= c '#\CSI) (let ((chars '()) c) (loop ! (setq c (read-char stream)) (unless (char<= #\Space c #\?) (return)) (push c chars) *************** *** 394,476 **** ! ;; This is another class of generic streams. A KEYBOARD stream is just ! ;; a wrapper around another stream, just like the ALIAS streams in gstream.lsp, ! ;; except that the read-char method calls the read-keyboard-char function. ;; The mode is switched to raw when the stream is created and switched back ;; when the stream is closed. ! (defclass keyboard-controller (generic-stream-controller) ! ((orig-stream :initarg :orig-stream) ! (orig-mode :initarg :orig-mode) ! ) ) ! (defun make-keyboard-stream (orig-stream) ! (make-generic-stream ! (make-instance 'keyboard-controller :orig-stream orig-stream ! :orig-mode (raw-mode orig-stream t) ! ) ) ) ! (defmethod generic-stream-read-char ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (read-keyboard-char orig-stream) ! ) ) ! (defmethod generic-stream-listen ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (raw-mode orig-stream t) ! (if (listen orig-stream) ! 0 ; something available ! (let ((ch (read-char-no-hang orig-stream nil t))) ! (cond ((eql ch t) -1) ; eof ! ((null ch) +1) ; nothing available, not EOF ! (t (unread-char ch orig-stream) 0) ; something available ! ) ) ) ) ) ! (defmethod generic-stream-clear-input ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (raw-mode orig-stream t) ! (clear-input orig-stream) ! t ! ) ) ! (defmethod generic-stream-write-char ((controller keyboard-controller) ch) ! (with-slots (orig-stream) controller ! (write-char ch orig-stream) ! ) ) ! (defmethod generic-stream-finish-output ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (finish-output orig-stream) ! ) ) ! (defmethod generic-stream-force-output ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (force-output orig-stream) ! ) ) ! (defmethod generic-stream-clear-output ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (clear-output orig-stream) ! ) ) ! (defmethod generic-stream-read-byte ((controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (raw-mode orig-stream t) ! (read-byte orig-stream nil nil) ! ) ) ! (defmethod generic-stream-write-byte (i (controller keyboard-controller)) ! (with-slots (orig-stream) controller ! (write-byte i orig-stream) ) ) ! (defmethod generic-stream-close ((controller keyboard-controller)) ! (with-slots (orig-stream orig-mode) controller ! (raw-mode orig-stream orig-mode) ! ) ! ; don't close orig-stream ) ! (defmethod generic-raw-mode ((controller keyboard-controller) mode) ! (with-slots (orig-stream) controller ! (raw-mode orig-stream mode) ) ) ! #| ! ;; Now we have all pieces that make up the stream *keyboard-input* : ! ;; The (make-window nil) stream switches modes automatically, and ! ;; (make-keyboard-stream ...) adds the read-keyboard-char translation. ! (defparameter *keyboard-input* (make-keyboard-stream (make-window nil))) ! ;; Beware! (make-keyboard-stream ...) switches the mode at stream creation time! ! |# ) ; #+AMIGA --- 387,431 ---- ! ;; Support for WITH-KEYBOARD and *KEYBOARD-INPUT* ! ;; The mode is switched to raw when the stream is created and switched back ;; when the stream is closed. ! ! (defclass keyboard-controller (terminal-controller) ! ((orig-mode :initform (raw-mode *terminal-io* t)) ! ; *terminal-io* is cached by terminal-controller ) ) ! ! (defmethod generic-stream-read-char ((controller keyboard-controller)) ! ; make some cursor and function keys mappings, see above ! (read-keyboard-char (controller-stream controller)) ) ! (defmethod generic-stream-listen ((controller screen-controller)) ! (generic-raw-mode controller t) ;; need to switch to raw mode ! (if (listen (controller-stream controller)) ! 0 ; something available ! +1 ; nothing available, not EOF ) ) + (defmethod generic-stream-clear-input ((controller screen-controller)) + (generic-raw-mode controller t) ;; need to switch to raw mode + (clear-input (controller-stream controller)) + T + ) ! (defmethod generic-stream-close ((controller keyboard-controller)) ! (with-slots (stream orig-mode) controller ! (raw-mode stream orig-mode) ! ) ) ! ! ; refine WITH-KEYBOARD expansion from USER1.LSP ! (defun system::do-with-keyboard (fn) ! (let ((*keyboard-input* (make-generic-stream ! (make-instance 'keyboard-controller)))) ! (unwind-protect ! (funcall fn) ! (close *keyboard-input*) ! ) ) ) ) ; #+AMIGA Only in src/: screen0.lsp Only in src/: screen1.lsp Only in src/: screen2.fas Only in src/: screen2.lib Only in src/: screen2.lsp Only in src/: sequence.d Only in src/: sfloat.d Only in src/: socket.d Only in src/: sort.d Only in src/: sp68000.mit.d Only in src/: sp68000.mot.d diff -c2 src.orig/spvw.d src/spvw.d *** src.orig/spvw.d Thu May 30 10:22:34 1996 --- src/spvw.d Tue Aug 13 19:41:53 1996 *************** *** 8061,8065 **** # Sprache, in der mit dem Benutzer kommuniziert wird: ! global uintL language; # Initialisiert die Sprache, gegeben die Sprachbezeichnung. --- 8061,8065 ---- # Sprache, in der mit dem Benutzer kommuniziert wird: ! global uintC language; # Initialisiert die Sprache, gegeben die Sprachbezeichnung. *************** *** 8099,8102 **** --- 8099,8106 ---- if (langname) { if (init_language_from(langname)) return; } + #ifdef AMIGAOS + langname = getenv("Language"); # since OS 3.0 + { if (init_language_from(langname)) return; } + #endif } { var reg1 const char* lang = getenv("LANG"); *************** *** 8902,8906 **** var reg2 uintC count; dotimesC(count,*module->stab_size, ! { ptr->name = NIL; ptr->keywords = NIL; } ); # Die Pointer in der Objekt-Tabelle hat init_object_tab_1() schon vorinitialisiert. --- 8906,8910 ---- var reg2 uintC count; dotimesC(count,*module->stab_size, ! { ptr->name = NIL; ptr->keywords = NIL; ptr++; } ); # Die Pointer in der Objekt-Tabelle hat init_object_tab_1() schon vorinitialisiert. *************** *** 9453,9456 **** --- 9457,9462 ---- { exit(RETURN_FAIL); } #endif + # Wir wollen uns nicht mehr mit OS Version 1.x beschäftigen + if (SysBase->LibNode.lib_Version < 36) { exit(RETURN_FAIL); } if (Input_handle==Handle_NULL) { Input_handle = Input(); } if (Output_handle==Handle_NULL) { Output_handle = Output(); } *************** *** 9478,9484 **** (CPU_IS_68000 # der 68000 hat nur 24 Bit Adreßbereich, ? MEMF_ANY # nie ein zweiter Versuch nötig ! : SysBase->LibNode.lib_Version > 35 # Betriebssystem-Version >= 2.0 ? ! ? MEMF_24BITDMA # ja -> hat Flag MEMF_24BITDMA ! : MEMF_CHIP # nein -> muß MEMF_CHIP verwenden ); #endif --- 9484,9488 ---- (CPU_IS_68000 # der 68000 hat nur 24 Bit Adreßbereich, ? MEMF_ANY # nie ein zweiter Versuch nötig ! : MEMF_24BITDMA # sonst Flag MEMF_24BITDMA ); #endif *************** *** 10886,10890 **** { stream_close(&STACK_0); \ if (ergebnis<0) { OS_error(); } # Fehler aufgetreten? \ ! fehler_device_possibily_full(STACK_0); \ } \ end_system_call(); \ --- 10890,10894 ---- { stream_close(&STACK_0); \ if (ergebnis<0) { OS_error(); } # Fehler aufgetreten? \ ! fehler_device_possibly_full(STACK_0); \ } \ end_system_call(); \ *************** *** 11241,11245 **** && (ptr1->key_anz == ptr2->key_anz) ) ) ! { PRINT_VALS(req_anz); PRINT_VALS(opt_anz); --- 11245,11249 ---- && (ptr1->key_anz == ptr2->key_anz) ) ) ! { PRINT_VALS(req_anz); PRINT_VALS(opt_anz); *************** *** 11519,11523 **** if (offset == -1) goto abbruch1; elif (offset == -2) goto abbruch2; ! elif (offset < 0) abort(); else inc_file_offset(offset); } --- 11523,11527 ---- if (offset == -1) goto abbruch1; elif (offset == -2) goto abbruch2; ! elif (offset < 0) { abort(); } else inc_file_offset(offset); } *************** *** 11722,11727 **** #undef READ begin_system_call(); ! #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM) || defined(AMIGAOS) || defined(RISCOS) || defined(WIN32_DOS) || defined(WIN32_UNIX) if ( CLOSE(handle) <0) goto abbruch1; #endif end_system_call(); --- 11726,11734 ---- #undef READ begin_system_call(); ! #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS) || defined(WIN32_DOS) || defined(WIN32_UNIX) if ( CLOSE(handle) <0) goto abbruch1; + #elif defined(AMIGAOS) + # Never close handles twice + if ( CLOSE(handle) <0) { handle = Handle_NULL; goto abbruch1; } #endif end_system_call(); *************** *** 11857,11869 **** # Es gibt eine Utility, die ein Executable nach einem Versionsstring absucht. global const char version_string[] = ! "$VER: CLISP " VERSION #if defined(WIDE) ! " (wide)" #elif defined(AMIGA3000) ! " (high)" #else ! " (low)" #endif ! "\r\n"; #endif --- 11864,11879 ---- # Es gibt eine Utility, die ein Executable nach einem Versionsstring absucht. global const char version_string[] = ! "$VER: CLISP" #if defined(WIDE) ! "-wide" #elif defined(AMIGA3000) ! "-high" ! #elif defined(MC68000) ! "-68000" #else ! "-low" #endif ! " "STRINGIFY(VERSION_YYYY)"."STRINGIFY(VERSION_MM) # version.revision ! " (" VERSION ")\r\n"; # Datum in Klammern #endif Only in src/: spvwtabf.d Only in src/: spvwtabo.d Only in src/: spvwtabs.d Only in src/: stdwin.d diff -c2 src.orig/stream.d src/stream.d *** src.orig/stream.d Wed May 22 16:09:58 1996 --- src/stream.d Thu Jun 13 23:18:21 1996 *************** *** 1096,1100 **** if (!nullp(TheStream(stream)->strm_isatty)) # interaktiv ! { if (WaitForChar(handle,1000L)) # 1/1000 sec auf ein Zeichen warten { end_system_call(); return signean_null; } # eins da else --- 1096,1100 ---- if (!nullp(TheStream(stream)->strm_isatty)) # interaktiv ! { if (WaitForChar(handle,0L)) # 0 usec auf ein Zeichen warten { end_system_call(); return signean_null; } # eins da else *************** *** 1146,1150 **** { begin_system_call(); loop ! { if (!WaitForChar(handle,1000L)) # 1/1000 sec auf ein Zeichen warten break; # keins mehr da -> fertig {var uintB c; --- 1146,1150 ---- { begin_system_call(); loop ! { if (!WaitForChar(handle,0L)) # 0 usec auf ein Zeichen warten break; # keins mehr da -> fertig {var uintB c; *************** *** 3783,3819 **** #ifdef AMIGAOS - # include <exec/types.h> - # include <dos/dosextens.h> - # include <inline/exec.h> - # include <inline/dos.h> - - # From Ralph Babel, The Amiga GURU book, p. 278 - # SetMode() for pre-2.0 systems - - local LONG setmode (BPTR fh, LONG mode); - local LONG setmode(fh,mode) - var BPTR fh; - var LONG mode; - { if (DOSBase->dl_lib.lib_Version > 35) - { return SetMode(fh,mode); } - else - # pre-2.0, no SetMode in the library - { register struct MsgPort *fh_type = ((struct FileHandle *)BADDR(fh))->fh_Type; - if (fh_type==NULL) - return DOSFALSE; /* NIL: has no message port */ - {var LONGALIGNTYPE(struct StandardPacket) spb; - var struct StandardPacket * sp = LONGALIGN(&spb); - var struct MsgPort * mp = &((struct Process *)FindTask(NULL))->pr_MsgPort; - sp->sp_Msg.mn_Node.ln_Name = (char *)&sp->sp_Pkt; - sp->sp_Pkt.dp_Link = &sp->sp_Msg; - sp->sp_Pkt.dp_Port = mp; - sp->sp_Pkt.dp_Type = ACTION_SCREEN_MODE; - sp->sp_Pkt.dp_Arg1 = mode; /* 0 for CON */ - PutMsg(fh_type, &sp->sp_Msg); - WaitPort(mp); - GetMsg(mp); /* assumes that no other packets are pending */ - return sp->sp_Pkt.dp_Res1; - } }} - # Genauso wie den Terminal-Stream können wir auch beliebige interaktive # Handle-Streams (andere Text-Fenster) in den Raw-Modus schalten. --- 3783,3786 ---- *************** *** 3827,3831 **** global void terminal_sane() { if (!(terminal_mode == 0)) ! { begin_system_call(); setmode(Input_handle,0); end_system_call(); terminal_mode = 0; } } --- 3794,3798 ---- global void terminal_sane() { if (!(terminal_mode == 0)) ! { begin_system_call(); SetMode(Input_handle,0); end_system_call(); terminal_mode = 0; } } *************** *** 3857,3861 **** else { begin_system_call(); ! success = setmode(Input_handle,new_mode); end_system_call(); terminal_mode = new_mode; --- 3824,3828 ---- else { begin_system_call(); ! success = SetMode(Input_handle,new_mode); end_system_call(); terminal_mode = new_mode; *************** *** 3868,3872 **** else { begin_system_call(); ! success = setmode(TheHandle(TheStream(stream)->strm_ihandle),new_mode); end_system_call(); if (new_mode) --- 3835,3839 ---- else { begin_system_call(); ! success = SetMode(TheHandle(TheStream(stream)->strm_ihandle),new_mode); end_system_call(); if (new_mode) Only in src/: subr.d Only in src/: subrkw.d Only in src/: symbol.d Only in src/: testd.d Only in src/: time.d Only in src/: timezone.fas Only in src/: timezone.lib Only in src/: timezone.lsp Only in src/: TODO Only in src/: trace.fas Only in src/: trace.lib Only in src/: trace.lsp Only in src/: type.fas Only in src/: type.lib Only in src/: type.lsp Only in src/: user1.fas Only in src/: user1.lib diff -c2 src.orig/user1.lsp src/user1.lsp *** src.orig/user1.lsp Mon Apr 15 16:30:42 1996 --- src/user1.lsp Wed Aug 07 00:59:40 1996 *************** *** 149,153 **** (defun debug-return () (return-from-eval-frame *debug-frame* ! (read-form #L{ DEUTSCH "Werte: " --- 149,153 ---- (defun debug-return () (return-from-eval-frame *debug-frame* ! (read-form #L{ DEUTSCH "Werte: " *************** *** 162,166 **** (defun commands0 () (list ! #L{ DEUTSCH " Help = diese Liste --- 162,166 ---- (defun commands0 () (list ! #L{ DEUTSCH " Help = diese Liste *************** *** 176,182 **** ) ) (defun commands1 () ! (let ((part1 ! #L{ ! DEUTSCH " Help = dieses Menü Abort = Abbruch, Rücksprung zur nächsthöheren Eingabeschleife --- 176,182 ---- ) ) (defun commands1 () ! (list ! #L{ ! DEUTSCH " Help = dieses Menü Abort = Abbruch, Rücksprung zur nächsthöheren Eingabeschleife *************** *** 190,224 **** Up = nächsthöheren Frame inspizieren Top = obersten Frame inspizieren ! Down = nächstneueren Frame inspizieren" ! ENGLISH " ! Help = this command list ! Abort = abort to the next recent input loop ! Unwind = abort to the next recent input loop ! Mode-1 = inspect all the stack elements ! Mode-2 = inspect all the frames ! Mode-3 = inspect only lexical frames ! Mode-4 = inspect only EVAL and APPLY frames (default) ! Mode-5 = inspect only APPLY frames ! Where = inspect this frame ! Up = go up one frame, inspect it ! Top = go to top frame, inspect it ! Down = go down one frame, inspect it" ! FRANCAIS " ! Help = ce menu-ci ! Abort = arrêt, retour au niveau supérieur ! Unwind = arrêt, retour au niveau supérieur ! Mode-1 = examiner tous les éléments de la pile ! Mode-2 = examiner tous les «frames» ! Mode-3 = examiner uniquement les «frames» lexicaux ! Mode-4 = examiner uniquement les «frames» EVAL et APPLY (par défaut) ! Mode-5 = examiner uniquement les «frames» APPLY ! Where = examiner ce «frame» ! Up = examiner un «frame» supérieur ! Top = examiner le «frame» le plus élevé ! Down = examiner un prochain «frame» plus récent (inférieur)" ! }) ! (part2 ! #L{ ! DEUTSCH " Bottom = neuesten Frame inspizieren Backtrace-1 = alle Stack-Elemente auflisten --- 190,194 ---- Up = nächsthöheren Frame inspizieren Top = obersten Frame inspizieren ! Down = nächstneueren Frame inspizieren Bottom = neuesten Frame inspizieren Backtrace-1 = alle Stack-Elemente auflisten *************** *** 232,236 **** Redo = Form im EVAL-Frame erneut auswerten Return = EVAL-Frame mit gegebenen Werten verlassen" ! ENGLISH " Down = go down one frame, inspect it Bottom = go to bottom (most recent) frame, inspect it --- 202,217 ---- Redo = Form im EVAL-Frame erneut auswerten Return = EVAL-Frame mit gegebenen Werten verlassen" ! ENGLISH " ! Help = this command list ! Abort = abort to the next recent input loop ! Unwind = abort to the next recent input loop ! Mode-1 = inspect all the stack elements ! Mode-2 = inspect all the frames ! Mode-3 = inspect only lexical frames ! Mode-4 = inspect only EVAL and APPLY frames (default) ! Mode-5 = inspect only APPLY frames ! Where = inspect this frame ! Up = go up one frame, inspect it ! Top = go to top frame, inspect it Down = go down one frame, inspect it Bottom = go to bottom (most recent) frame, inspect it *************** *** 245,249 **** Redo = re-evaluate form in EVAL frame Return = leave EVAL frame, prescribing the return values" ! FRANCAIS " Bottom = examiner le «frame» le plus récent (le plus bas) Backtrace-1 = montrer tous les éléments de la pile --- 226,242 ---- Redo = re-evaluate form in EVAL frame Return = leave EVAL frame, prescribing the return values" ! FRANCAIS " ! Help = ce menu-ci ! Abort = arrêt, retour au niveau supérieur ! Unwind = arrêt, retour au niveau supérieur ! Mode-1 = examiner tous les éléments de la pile ! Mode-2 = examiner tous les «frames» ! Mode-3 = examiner uniquement les «frames» lexicaux ! Mode-4 = examiner uniquement les «frames» EVAL et APPLY (par défaut) ! Mode-5 = examiner uniquement les «frames» APPLY ! Where = examiner ce «frame» ! Up = examiner un «frame» supérieur ! Top = examiner le «frame» le plus élevé ! Down = examiner un prochain «frame» plus récent (inférieur) Bottom = examiner le «frame» le plus récent (le plus bas) Backtrace-1 = montrer tous les éléments de la pile *************** *** 257,287 **** Redo = réévaluer la forme dans le «frame» EVAL Return = quitter le «frame» EVAL avec certaines valeurs" ! }) ! ) ! (list ! (concatenate 'string part1 part2) ! (cons "Help" #'debug-help ) ! (cons "?" #'debug-help ) ! (cons "Abort" #'debug-unwind) ! (cons "Unwind" #'debug-unwind) ! (cons "Mode-1" #'debug-mode-1) ! (cons "Mode-2" #'debug-mode-2) ! (cons "Mode-3" #'debug-mode-3) ! (cons "Mode-4" #'debug-mode-4) ! (cons "Mode-5" #'debug-mode-5) ! (cons "Where" #'debug-where ) ! (cons "Up" #'debug-up ) ! (cons "Top" #'debug-top ) ! (cons "Down" #'debug-down ) ! (cons "Bottom" #'debug-bottom) ! (cons "Backtrace-1" #'debug-backtrace-1) ! (cons "Backtrace-2" #'debug-backtrace-2) ! (cons "Backtrace-3" #'debug-backtrace-3) ! (cons "Backtrace-4" #'debug-backtrace-4) ! (cons "Backtrace-5" #'debug-backtrace-5) ! (cons "Backtrace" #'debug-backtrace ) ! ) ) ) ! ! (defun commands2 () (list (cons "Break+" #'debug-trap-on ) --- 250,276 ---- Redo = réévaluer la forme dans le «frame» EVAL Return = quitter le «frame» EVAL avec certaines valeurs" ! } ! (cons "Help" #'debug-help ) ! (cons "?" #'debug-help ) ! (cons "Abort" #'debug-unwind) ! (cons "Unwind" #'debug-unwind) ! (cons "Mode-1" #'debug-mode-1) ! (cons "Mode-2" #'debug-mode-2) ! (cons "Mode-3" #'debug-mode-3) ! (cons "Mode-4" #'debug-mode-4) ! (cons "Mode-5" #'debug-mode-5) ! (cons "Where" #'debug-where ) ! (cons "Up" #'debug-up ) ! (cons "Top" #'debug-top ) ! (cons "Down" #'debug-down ) ! (cons "Bottom" #'debug-bottom) ! (cons "Backtrace-1" #'debug-backtrace-1) ! (cons "Backtrace-2" #'debug-backtrace-2) ! (cons "Backtrace-3" #'debug-backtrace-3) ! (cons "Backtrace-4" #'debug-backtrace-4) ! (cons "Backtrace-5" #'debug-backtrace-5) ! (cons "Backtrace" #'debug-backtrace ) ! ) ) ! (defun commands2 () (list (cons "Break+" #'debug-trap-on ) *************** *** 363,367 **** (when interactive-p (terpri *debug-io*) ! (write-string #L{ DEUTSCH "Sie können (mit Continue) fortfahren." --- 352,356 ---- (when interactive-p (terpri *debug-io*) ! (write-string #L{ DEUTSCH "Sie können (mit Continue) fortfahren." *************** *** 375,379 **** (terpri *debug-io*) (when interactive-p ! (write-string #L{ DEUTSCH "Wenn Sie (mit Continue) fortfahren: " --- 364,368 ---- (terpri *debug-io*) (when interactive-p ! (write-string #L{ DEUTSCH "Wenn Sie (mit Continue) fortfahren: " *************** *** 528,532 **** (let ((*standard-output* *debug-io*)) (terpri #|*debug-io*|#) ! (write-string #L{ DEUTSCH "Step " --- 517,521 ---- (let ((*standard-output* *debug-io*)) (terpri #|*debug-io*|#) ! (write-string #L{ DEUTSCH "Step " *************** *** 539,543 **** (write-string " ==> " #|*debug-io*|#) (case (length values) ! (0 (write-string #L{ DEUTSCH "Keine Werte" --- 528,532 ---- (write-string " ==> " #|*debug-io*|#) (case (length values) ! (0 (write-string #L{ DEUTSCH "Keine Werte" *************** *** 547,551 **** #|*debug-io*|# ) ) ! (1 (write-string #L{ DEUTSCH "Wert: " --- 536,540 ---- #|*debug-io*|# ) ) ! (1 (write-string #L{ DEUTSCH "Wert: " *************** *** 558,562 **** ) (t (write (length values) #|:stream *debug-io*|#) ! (write-string #L{ DEUTSCH " Werte: " --- 547,551 ---- ) (t (write (length values) #|:stream *debug-io*|#) ! (write-string #L{ DEUTSCH " Werte: " *************** *** 600,604 **** ) (fresh-line #|*debug-io*|#) ! (write-string #L{ DEUTSCH "Step " --- 589,593 ---- ) (fresh-line #|*debug-io*|#) ! (write-string #L{ DEUTSCH "Step " *************** *** 635,639 **** ) ) ) ) (when watchp ! (let ((form (read-form #L{ DEUTSCH "Abbruchbedingung: " --- 624,628 ---- ) ) ) ) (when watchp ! (let ((form (read-form #L{ DEUTSCH "Abbruchbedingung: " *************** *** 695,699 **** (if (interactive-stream-p *debug-io*) (progn ! (write-string #L{ DEUTSCH "Wenn Sie (mit Continue) fortfahren: " --- 684,688 ---- (if (interactive-stream-p *debug-io*) (progn ! (write-string #L{ DEUTSCH "Wenn Sie (mit Continue) fortfahren: " *************** *** 715,719 **** (defun warn (format-string &rest args) (terpri *error-output*) ! (write-string #L{ DEUTSCH "WARNUNG:" --- 704,708 ---- (defun warn (format-string &rest args) (terpri *error-output*) ! (write-string #L{ DEUTSCH "WARNUNG:" *************** *** 765,769 **** (fresh-line *query-io*) (apply #'format *query-io* format-string args) ! (write-string #L{ DEUTSCH " (j/n) " --- 754,758 ---- (fresh-line *query-io*) (apply #'format *query-io* format-string args) ! (write-string #L{ DEUTSCH " (j/n) " *************** *** 781,785 **** ) ) ) (terpri *query-io*) ! (write-string #L{ DEUTSCH "Bitte mit j oder n antworten: " --- 770,774 ---- ) ) ) (terpri *query-io*) ! (write-string #L{ DEUTSCH "Bitte mit j oder n antworten: " *************** *** 795,799 **** (fresh-line *query-io*) (apply #'format *query-io* format-string args) ! (write-string #L{ DEUTSCH " (ja/nein) " --- 784,788 ---- (fresh-line *query-io*) (apply #'format *query-io* format-string args) ! (write-string #L{ DEUTSCH " (ja/nein) " *************** *** 815,819 **** ) (terpri *query-io*) ! (write-string #L{ DEUTSCH "Bitte mit ja oder nein antworten: " --- 804,808 ---- ) (terpri *query-io*) ! (write-string #L{ DEUTSCH "Bitte mit ja oder nein antworten: " *************** *** 825,828 **** --- 814,825 ---- (defvar *keyboard-input*) + #+AMIGA + (defun do-with-keyboard (fn) + ;; Funktion wird umdefiniert falls SCREEN geladen ist + (unwind-protect + (progn + (sys::terminal-raw *terminal-io* t) + (funcall fn)) + (sys::terminal-raw *terminal-io* nil))) (defmacro with-keyboard (&body body) #+(or DOS OS/2 WIN32-DOS) ; *keyboard-input* existiert schon *************** *** 837,846 **** ) #+AMIGA ! `(LET ((*KEYBOARD-INPUT* (SCREEN::MAKE-KEYBOARD-STREAM *TERMINAL-IO*))) ! (UNWIND-PROTECT ! (PROGN ,@body) ! (CLOSE *KEYBOARD-INPUT*) ! ) ) ) - --- 834,838 ---- ) #+AMIGA ! `(DO-WITH-KEYBOARD (FUNCTION (LAMBDA () ,@body))) ) Only in src/: user2.fas Only in src/: user2.lib diff -c2 src.orig/user2.lsp src/user2.lsp *** src.orig/user2.lsp Mon Apr 15 16:30:44 1996 --- src/user2.lsp Fri Jul 05 00:46:37 1996 *************** *** 525,528 **** --- 525,537 ---- } ) ) ) + #+(or AMIGA FFI) + (FOREIGN-POINTER + (format s + #L{ + DEUTSCH "ein Foreign-Pointer." + ENGLISH "a foreign pointer" + FRANCAIS "un pointeur étranger." + } + ) ) #+FFI (FOREIGN-ADDRESS Only in src/: vcode.d Only in src/: vcode.lsp Only in src/: version.h