VolksForth/AtariST/MISC.FB

\\ miscellaneous words                                 cas202007                                                                this file contains words that are frequently used but do not    fit into any of the other source files                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ Loadscreen for misc tools                      cas  21july2020                                                                Onlyforth                                                                                                                       1 2  +thru                                                                                                                      ' .blk Is .status                                                                                                                                                                               \ 3 +load   setvec                                                                                                                                                                                                                                                                                                                                                                                                                                              \ common used words                              cas  21july2020                                                                : >absaddr   ( addr -- abs_laddr )       0  forthstart d+ ;                                                                     : .blk     ( -- )         blk @   ?dup   0= ?exit                    dup 1 =  IF  cr file?  THEN   ."  Blk " . ?cr ;                                                                            : abort(  ( f -- )                                                 IF  [compile] .(  true abort"  !"  THEN  [compile] ( ;                                                                       \needs arguments   abort( use definition in FILEINT.SCR)                                                                                                                                                                                                                                                                                                                                        \ more common word definitions                   cas  21july2020                                                                | Create: cpull                                                       rp@ count  2dup + even rp!  r> swap cmove ;                                                                               : cpush  ( addr len --)   r> -rot  over >r                            rp@ over 2+ -  even dup rp!  place  cpull >r  >r ;                                                                                                                                        : bell                           7 con! ;                       : blank    ( addr count -- )     bl fill ;                                                                                                                                                                                                                                                                                                                                                      \ disable TOS alerts                             cas  21july2020                                                                Create oldvec   4 allot                                                                                                         Label newvector                                                    -8 D1 cmpi  0<> IF  -&13 D1 cmpi  0<>  IF                         .l oldvec pcrel) A2 move   A2 ) jmp   THEN  THEN              .l D1 D0 move   rts   end-code                                                                                               : setvec    $0.0404 l2@  oldvec 2!                                          newvector >absaddr   $0.0404 l2! ;                                                                                  : restvec   oldvec 2@ $0.0404 l2! ;                                                                                             : bye       restvec bye ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ Loadscreen f<>r Diverses                              26oct86we                                                                setzt Searchorder auf     FORTH FORTH ONLY    FORTH                                                                             kompiliert die n<>chsten 2 Screens.                                                                                              .STATUS ist ein 'deferred word', das jeweils beim Kompilieren    eines Quelltextscreens aufgerufen wird.                                                                                        Screen 4 wird nicht mitkompiliert, denn SETVEC mu<6D> nach jedem    Neustart wieder aufgerufen werden. Falls Sie diese Funktion     nutzen wollen, m<>ssen Sie nach jedem Laden SETVEC eingeben.     (Dazu mu<6D> nat<61>rlich Screen 4 kompiliert worden sein.)                                                                                                                                                                                                          \ H<>ufig benutzte Definitionen                         26oct86we                                                                >ABSADDR    rechnet eine - relative- Adresse im FORTH-System in             eine absolute 32-Bit-Adresse um.                    .BLK        gibt die Nummer des gerade kompilierten Screens aus,            bei Screen 1 auch den Filenamen.                                                                                    ABORT(      bewirkt das gleiche wie ABORT", ist aber im Direkt-             modus zul<75>ssig.                                                                                                     ARGUMENTS   pr<70>ft, ob eine bestimmte (Mindest-)Anzahl von Werten            auf dem Stack liegt. Dieses Wort ist bereits im                 FORTHKER.PRG vorhanden, da es vom File-Interface                gebraucht wird.                                                                                                                                                                     \ H<>ufig benutzte Definitionen II                      26oct86we                                                                CPUSH       sorgt im Zusammenspiel mit CPULL daf<61>r, da<64> ein                 String (bzw. ein beliebiger Speicherbereich, z.B.               ein Array) nach dem Aufruf einer Funktion wieder                die alten Werte erh<72>lt. Entspricht dem Wort PUSH,               aber f<>r Strings anstelle von Variablen.                                                                                                                                            BELL        Dieses Wort ist selbsterkl<6B>rend !!!                 BLANK       f<>llt ab addr count Speicherstellen mit Leerzeichen.                                                                                                                                                                                                                                                                                                                                \ TOS-Alerts abschalten                                26oct86we                                                                Vielleicht haben Sie es schon einmal bemerkt. Wenn Sie auf eine  Diskette schreiben wollen, bei der der Schreibschutz gesetzt    ist, erscheint eine Alert-Box, aber ohne Maus, soda<64> Sie den    ABBRUCH-Knopf nur durch geduldiges Experimentieren mit der Maus erreichen k<>nnen. Diese Box wird vom Betriebssystem ohne unser  Zutun und ohne Einwirkungsm<73>glichkeit erzeugt.                 NEWVECTOR <20>ndert den zugeh<65>rigen Vector (critical error handler) so, da<64> diese Boxen nicht mehr erscheinen, wohl aber die, in    denen z.B. zum Diskettenwechsel aufgefordert wird.             SETVEC und RESTVEC dienen zum Umschalten zwischen altem und      neuen Vector.                                                  Insbesondere mu<6D> BYE den alten Vector wiederherstellen, sonst    st<73>rzt das System gnadenlos ab.                                Noch keine besonders elegante L<>sung, aber besser als keine !!