GTK+ mit Forth (1) - GTK Stock Viewer, Listing 1: GtkComboBoxText/example.2.4th.
\ GtkComboBoxText/example.2.4th needs GtkToplevel needs GtkTable needs GtkLabel Array needs GtkAlignment Array needs GtkComboBoxText needs GtkImageFromStock needs GtkButton needs GSList \ ------------------------------------------------------------------------------ \ csp4th : GtkComboBox Example 2 MM-080311 \ ------------------------------------------------------------------------------ gtk api definitions libgtk import gtk_stock_list_ids ( -- *list ) GtkComboBoxText definitions private vocabulary example.2 self example.2 definitions also gtk api GtkToplevel new window GtkTable new table GtkLabel Array new labels GtkAlignment Array new alignments GtkComboBoxText new combo GtkImage new image GtkButton new button GSList new list :: ( wid data -- ) 2drop gtk main_quit ; 2 20 cb cb.quit :: ( wid data -- ) 2drop combo @ dup if 2dup image from-stock button-size ! button label ! then ; 2 20 cb cb.changed : %label ( -- xopts yopts xpad ypad ) GTK_FILL 0 0 0 ; : %alignment ( -- xopts yopts xpad ypad ) GTK_FILL 0 12 0 ; : viewer ( -- ) " GTK Stock Viewer" window init 12 window border-width ! window resizable off " destroy" cb.quit 0 window signal connect drop table init window add 8 table column-spacing ! 8 table row-spacing ! 3 labels init " Stock Item:" 0 labels of init 0 1 0 1 %label table attach " Image:" 1 labels of init 0 1 1 2 %label table attach " Button:" 2 labels of init 0 1 2 3 %label table attach 3 0 do i labels of xalign right loop 3 alignments init 3 0 do i alignments of init 1 2 i dup 1+ %alignment table attach loop combo init 0 alignments of add " changed" cb.changed 0 combo signal connect drop " ?" image from-stock button-size init 1 alignments of add " ?" button init 2 alignments of add 3 0 do i alignments of xalign left loop gtk_stock_list_ids list init list size dup 1- swap 0 do dup i - list of @ dup zcount combo append free loop drop list free 0 combo activate window show_all ; hide cb.quit hide cb.changed previous viewer term? [IF] ?? [ELSE] gtk main bye [THEN] \ ------------------------------------------------------------------------------ \ Last revision: MM-080803 show all -> show_all , gtk main -> gtk main_quit \ MM-080525 : init -> : viewer
Reverse–Engineering–Preventer mit DS2401, ALL950828 V0.06 first release.
\ -------------------------------------------------------------- \ history: last revision first ALL 14:07 28AUG95 \ ALL950828 V0.06 first release \ .... \ ALL950112 V0.01 first try \ -------------------------------------------------------------- \ TMEM? DALLAS TOUCHMEMORY ALL 11:53 28AUG95 DECIMAL ASSEMBLER P1.5 EQU $PTM \ define TOUCH-MEM DATA port pin FORTH HEX 33 EQU cTMRD DECIMAL \ 0F or 33 are read commands \ -------------------------------------------------------------- \ TMEM? DALLAS TOUCHMEMORY present? ALL 21:13 14APR96 CODE TMEM? ( -- t=PRESENT ) \ TM present? A,# 4 MOV $PTM CLR \ start of RESET pulse LOW B ,# 250 MOV 1$: B , 1$ DJNZ \ 480..960uSEC->500Tcycles $PTM SETB \ end of RESET pulse HIGH B ,# 6 MOV C CLR \ clear CY = NO_presence 2$: $PTM , 3$ JB \ B: HIGH, leave loop B , 2$ DJNZ \ LOOP for 3360uSEC ACC , 2$ DJNZ \ if DATA stays LOW 9$ SJMP \ STUCK LOW 3$: B ,# 40 MOV \ 60..240uSEC-> 160Tcycles 4$: C,/ $PTM ORL B , 4$ DJNZ \ delay CY=1=PRESENCE detect 9$: A CLR A,# 0 SUBB R1,A MOV APUSH LJMP END-CODE \ -------------------------------------------------------------- \ TM><CY TM><bit0 exchange bits w/ DOW ALL 21:14 14APR96 \ 15uS DS2401 window, then MASTER window, 60..120uS total slot PROC TM><CY \ exchange CY and TMdata bit B PUSH $PTM CLR NOP NOP NOP NOP \ start time slot 1..15uSEC $PTM ,C MOV \ >=1uS ..6T, send CY B ,# 05 MOV 1$: B , 1$ DJNZ \ ..6+2+10=18Tcycles C, $PTM MOV \ read DS_DATA ..20Tcycles B ,# 18 MOV 1$: B , 1$ DJNZ \ 20+2+36=78Tcycles B POP \ =60..120uSEC =tSLOT $PTM SETB \ terminate time slot RET END-PROC CODE TM><bit0 ( c -- c' ) \ exchange bit0 and TMdata DP=SP DPL INC A,@DPTR MOVX \ get c -> ACC A RRC TM><CY LCALL A RLC @DPTR,A MOVX \ put ACC -> c' NEXT LJMP END-CODE \ -------------------------------------------------------------- \ TMC><C TMRD TMWR exchange bytes w/ DOW ALL 21:15 14APR96 CODE TM><C ( c -- c' ) \ exchange byte and TMdata DP=SP DPL INC A,@DPTR MOVX \ get c -> ACC B PUSH B ,# 8 MOV \ bit count=8 1$: A RRC TM><CY LCALL B , 1$ DJNZ \ send a bit A RRC \ get final bit B POP @DPTR,A MOVX \ put ACC -> c' NEXT LJMP END-CODE : TMRD ( -- c ) 255 TM><C ; : TMWR ( c -- ) TM><C DROP ; \ -------------------------------------------------------------- \ CRC8 =X^8+X^5+X^4+1 ALL 21:17 14APR96 CODE CRC8 ( crc char -- crc' ) DP=SP \ build CRC8 DPL INC A,@DPTR MOVX DPTR INC \ charL ->ACC R0,A MOV \ -> R0 DPL INC A,@DPTR MOVX R1,A MOV \ crc -> R1 B ,# 8 MOV A,R0 MOV \ B=bit count; A=char 1$: A,R1 XRL A RRC \ CY=char XOR crc.0 A,R1 MOV 2$ JNC \ NC: bit0 was 0 A,# 24 XRL \ 18h feedbacks 2$: A RRC R1,A MOV \ positition new crc A,R0 MOV A RR R0,A MOV \ next bit to bit0 B , 1$ DJNZ \ NZ: more bits A,R1 MOV @DPTR,A MOVX DPL DEC \ put crc' DP=>SP LJMP END-CODE \ -------------------------------------------------------------- \ .tm# TML show DOW/DS2401 data ALL 12:43 31JAN95 \ L. shows low byte as 2 HEX chars : .tm# TMEM? IF CR cTMRD TM><C \ 33h | 0Fh is RD CMD DROP 0 ( -- cCRC ) 8 0 DO TMRD DUP L. CRC8 LOOP IF 7 EMIT ." CRC error " THEN \ append moaning THEN ; : TML BEGIN .tm# ESC? UNTIL ; \ an endless loop shows DOW \ --------------------------------------------------------------
euler9 .solution ( uho)
\ Euler 9 uho 2008-08-24 \ a + b + c = 1000 : a_b_c ( a b -- a b c ) 2dup + 1000 swap - ; \ a^2 + b^2 = c^2 : pytriple? ( a b c -- flag ) >r dup * swap dup * + r> dup * = ; : euler9? ( a b -- flag ) a_b_c pytriple? ; : euler9 ( -- a b c ) 500 dup 1 DO dup I DO J I euler9? IF drop J I a_b_c UNLOOP UNLOOP EXIT THEN LOOP LOOP drop 0 0 0 ; : .solution ( a b c -- ) dup IF >r cr ." a=" over . ." b=" dup . ." c=" r@ . cr ." a+b+c=" 2dup + r@ + . cr ." a*b*c=" * r> * . EXIT THEN drop drop drop cr ." No solution" ; euler9 .solution
Keeping track of Time; Study timers provided using gforth; Mac OSX (PowerBook G4).
And: Brian Fox in 2008, Elapsed timer for gforth compatible with Win32Forth.
\ Keeping track of Time \ Study timers provided using gforth - Mac OSX (PowerBook G4) vocabulary test test definitions : runtime-test ( -- ) page 0 3 at-xy ." time t2-t1 max min .s ratio" 0. 0. { D: utime0 D: utime1 } 0. 0. { D: usertime0 D: usertime1 } 0. 0. { D: systime0 D: systime1 } 0. 10000000000. { D: utmax D: utmin } 0. 10000000000. { D: usermax D: usermin } 0. 10000000000. { D: sysmax D: sysmin } begin \ permanent display times utime ( -- dutime ) to utime0 cputime ( -- duser0 dsystem0 ) to systime0 to usertime0 1000000 for ( insert testword here ) next cputime ( -- duser1 dsystem1 ) to systime1 to usertime1 utime ( -- dutime ) to utime1 \ formatted display of times cr 0 0 at-xy ." user: " usertime0 20 ud.r usertime1 usertime0 d- 2dup usermax d> if 2dup to usermax then 2dup usermin d< if 2dup to usermin then 10 ud.r usermax 10 ud.r usermin 10 ud.r space .s usermin d>f usermax d>f f/ f. cr 0 1 at-xy ." sys : " systime0 20 ud.r systime1 systime0 d- 2dup sysmax d> if 2dup to sysmax then 2dup sysmin d< if 2dup to sysmin then 10 ud.r sysmax 10 ud.r sysmin 10 ud.r space .s sysmin d>f sysmax d>f f/ f. cr 0 2 at-xy ." ut : " utime0 20 ud.r utime1 utime0 d- 2dup utmax d> if 2dup to utmax then 2dup utmin d< if 2dup to utmin then 10 ud.r utmax 10 ud.r utmin 10 ud.r space .s utmin d>f utmax d>f f/ f. key? until 0 5 at-xy ; \ Brian Fox in 2008 \ Elapsed timer for gforth compatible with Win32Forth : ms@ ( -- n ) utime drop 1000 / ; 0 value start-time : timer-reset ( -- ) ms@ to start-time ; : .#" ( n1 n2 -- a1 n3 ) >r 0 <# r> 0 ?do # loop #> ; : .elapsed ( -- ) ." Elapsed time: " ms@ start-time - 1000 /mod 60 /mod 60 /mod 2 .#" type ." :" 2 .#" type ." :" 2 .#" type ." ." 3 .#" type ; : elapse ( -<commandline>- ) timer-reset interpret cr .elapsed ; 0 [if] ----- Gforth 0.6.2, Copyright (C) 1995-2003 Free Software Foundation, Inc. Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license' Type `bye' to exit include elapsed.fs ok ok elapse 5000 ms Elapsed time: 00:00:05.000 ok elapse 10000 ms Elapsed time: 00:00:10.001 ok ----- Brian Fox [then] : .. bye ; words cr cr
Zutaten fuer FAT-Reparatur und Bootmaster unter Turbo-FORTH-83. Auch fuer ZF geeignet.
\ **************************************************** \ * * \ * BOOTMAST.FTH * \ * * \ * Zutaten fuer FAT-Reparatur und Bootmaster unter * \ * Turbo-FORTH-83. Auch fuer ZF geeignet. * \ * * \ * Fred Behringer - Forth-Gesellschaft - 8.8.2008 * \ * * \ **************************************************** \ ==================================================== \ Bei Arbeiten mit ZF: \ zf fload bootmast.fth - .fth nicht vergessen! \ attributs off wegnehmen! attributs in ZF unbekannt. \ Ansonsten scheint auch unter ZF alles zu gehen. \ ==================================================== attributs off \ Fuer den Fall, dass kein ANSI.SYS in der CONFIG.SYS ist. \ Bei Arbeiten mit ZF wegnehmen ! hex 210 allot here \ Platz fuer mind. 1 Sektor = 512d Bytes here 0f and - \ sectbuf an Paragraphenanfang 200 - \ Anfang des Sektorpuffers constant sectbuf \ Liefert Adresse des Sektorpuffers \ Sektor lesen: cx = Spur/Sektor-Kombination \ cx = Bits F-0 = FEDCBA98 76543210 : Spur = 76FEDCBA98 : Sektor = 543210 \ = ch cl : 76(cl) &ch : von cl code (getsect) ( seite spur/sektor -- ) ds push \ ds --> es es pop 80 # dl mov \ dl = erste Festplatte cx pop \ Kombination aus Spur (track #) und Sektor ax pop al dh mov \ dh = Seitennummer (head #) sectbuf # bx mov \ bx auf den Anfang des Puffers setzen. 201 # ax mov \ Einen physikalischen Sektor lesen 13 int \ HD-Interrupt aufrufen next end-code \ Sektor schreiben: cx = Spur/Sektor-Kombination (wie unter "Sektor lesen"): \ Spur = ch mit vorangesetzten Bits 7-6 von cl, Sektor = Bits 5-0 von cl code (putsect) ( seite spur/sektor -- ) ds push \ ds --> es es pop 80 # dl mov \ dl = erste Festplatte cx pop \ Kombination aus Spur (track#) und Sektor ax pop al dh mov \ dh = Seitennummer (head #) sectbuf # bx mov \ bx auf den Anfang des Puffers setzen. 301 # ax mov \ Einen physikalischen Sektor schreiben. 13 int \ HD-Interrupt aufrufen next end-code \ 10 Bit Spur und 6 Bit Sektor --> 16 Bit Spur/Sektor \ In dieser Codierung steht es im Master-Boot-Record \ und so wird es in Int 13h, 2/3 in cx verlangt. code sp,sc>spsc ( sp sc -- spsc ) ax pop \ Sektoreingabe 3f # ax and \ Sektor = 6 niederwertige Bits von al bx pop \ Spureingabe 6 # cl mov \ Spur = Bit 6,7 von al vorn an bl bh cl shl \ um 6 Bit nach links bh al or \ Spurbits 6,7 nach Sektorbyte bl ah mov \ Beides in ax sammeln ax push \ und gemeinsam zum Stack next end-code \ Umkehrung von sp,sc>spsc. Weitere Erklaerungen dort. code spsc>sp,sc ( spsc -- sp sc ) ax pop \ Eingabe (und Aufbewahrung in ax) ax bx mov \ der Spur/Sektor-Kombination 6 # cl mov bl cl shr \ um 6 Bit nach rechts bl dh mov \ Spurbits 6,7 nach bits 0,1 von dh ah dl mov \ Spur dx zu 10 Bits ergaenzen dx push \ Spur auf Stack 3f # ax and \ Sektor = 6 niederwertige Bits von al ax push \ Sektor auf Stack next end-code \ MBR lesen und nach sectbuf speichern \ Die Partitionstabelle beginnt bei Adresse 1be. \ Der MBR endet mit den Bytes 55 aa. : getmbr ( -- ) 0 1 (getsect) ; \ Inhalt von sectbuf (gaanz vorsichtig!) in den MBR der Festplatte schreiben. : putmbr ( -- ) 0 1 (putsect) ; \ Sektor-Puffer am Bildschirm anzeigen : showsectbuf ( -- ) sectbuf 200 dump ; \ Nur 100 Bytes anzeigen : showsectbuf100 ( -- ) sectbuf 100 dump ; \ Sektoradresse s-ad (Spur/Sektor-Kombination wie bei (getsect)) des \ n-ten logischen Laufwerks (der erweiterten Partition) auf den Stack \ holen und auch den zugehoerigen Sektor nach sectbuf speichern. Die \ Partitionstabelle beginnt bei Parttab-Offset 1be; ansonsten hat der \ Parttab-Sektor bis auf die beiden Bytes 55 aa am Ende nur Nullen. \ Zur (besser aufbereiteten) Anzeige der Partitionstabelle des logischen \ Laufwerks n kann man (nach entsprechender Um-Interpretation) auch \ (showparttab) verwenden. Man verwechsle die Partitionstabellen der logischen \ Laufwerke der erweiterten Partition nicht mit derem jeweiligen Bootsektor. \ Die Partitionstabellen der logischen Laufwerke entsprechen dem entsprechenden \ (und am selben Platz liegenden) Teil des MBRs (der gesamten Festplatte). : getpart ( n -- s-ad ) \ n = 1 -> 1. logisches Laufwerk, usw. getmbr sectbuf 1b2 + \ Ausgangsposition im Puffer 4 0 \ 4 relevante Zeilen im MBR do 10 + dup c@ 5 = \ Schon erweiterte Partition? if 2 - @ leave then \ Ja, dann s-ad holen und raus. loop \ ( n s-ad(1) ) begin \ k = 0 ... 0 over \ ( n-k s-ad(k+1) 0 s-ad(k+1) ) (getsect) \ ( n-k s-ad(k+1) ) swap 1 - >r \ ( s-ad(k+1) ) sectbuf 1d0 + @ \ ( s-ad(k+1) s-ad(k+2)? ) dup 0= \ ( s-ad(k+1) s-ad(k+2) fl ) if drop 1 \ ( s-ad(k+1) 1 ) else nip 0 \ ( s-ad(k+2) 0 ) then \ ( s-ad(k+?) 0/1 ) r@ \ ( s-ad(k+?) 0/1 n-k-1 ) -rot r> \ ( n-k-1 s-ad(k+?) 0/1 n-k-1 ) 0= \ ( s-ad(k+?) 0/1 fl ) or \ ( s-ad(k+?) fl ) until \ parttab(n) jetzt in sectbuf drop sectbuf 1c0 + @ \ ( fl s-ad(n) ) swap if cr ." Letztes Ext-Laufwerk schon erreicht!" then ; \ Partitionstabelle eines logischen Laufwerks (der erweiterten Partition) aus \ dem Puffer sectbuf holen und an "richtiger Stelle" (nach s-ad) auf die Platte \ zurueckschreiben. s-ad ist derjenige Wert auf dem Stack, der nach Aufruf von \ getpart dort abgelegt wurde. s-ad enthaelt Spur und Sektor in der Codierung \ des Interrupts 13h. Die 0 in putpart entspricht der Seitennummer 0. \ Das Paar n getpart und putpart dient also der Reparatur einer verunglueckten \ Partitionstabelle eines logischen Laufwerks der erweiterten Partition - soweit \ eine solche ueberhaupt vorhanden ist. : putpart ( s-ad -- ) 0 swap (putsect) ; \ Aeusserste Vorsicht ! \ Bootsektor des logischen Laufwerks n (1 = erstes Laufwerk der \ erweiterten Partition usw) holen und in den Sektorpuffer schreiben \ Der Bootsektor des logischen Laufwerks n der erweiterten Partition hat nichts \ mit der Partitionstabelle des logischen Laufwerks zu tun! Voellig falsch waere \ es, sich nach n getboot irgendwelche brauchbaren Daten per (showparttab) \ anzeigen lassen zu wollen (siehe dort). : getboot ( n -- ) getpart 1 swap (getsect) ; \ Partition verstecken. Zunaechst nur in sectbuf (Sektorpuffer). MBR muss \ schon per getmbr in den Puffer geschrieben worden sein. Zum \ Wirksamwerdenlassen dann mit putmbr abschliessen! Vorsicht bei der erweiterten \ Partition! Es ist die Frage, ob ein Verstecken der erweiterten Partition \ sinnvoll ist. Das Verstecken von Partitionen mit zweistelligen \ Dateisystemkennungen wird hier nicht erlaubt. Davon betroffen sind \ insbesondere 82 (Linux swap) und 83 (Linux native). Windows ME auf FAT32-Basis \ hat die Kennung 0C und wird von hidepart voll einbezogen. Windows XP hat (bei \ der ueblichen NTFS-Basis) die Kennung 07 und wird von hidepart ebenfalls voll \ einbezogen. \ Achtung: Es wird bei hidepart, hideall und hideall-ext davon ausgegangen, dass \ Linux, falls vorhanden, in der erweiterten Partition liegt, dass Linux also in \ der Partitionstabelle des MBRs nicht in Erscheinung tritt. Andernfalls wuerde \ der hier verwendete Mechanismus des Versteckens oder Sichtbarmachens nicht \ greifen. Diese Dinge muessen unbedingt noch genauer untersucht werden. \ Alle Operationen spielen sich "nur" im Sektorpuffer sectbuf ab. Sie muessen \ dann noch per putmbr auf die Festplatte geschrieben und durch Neubooten \ des Computers wirksam gemacht werden. : hidepart ( n -- ) \ n wird vorsichtshalber auf [1..4] begrenzt. 1 - 3 and 10 * 1c2 + \ n-1 mal Zeilenverschiebung (10) plus Offset sectbuf + dup dup \ im Puffer (dreimal). c@ f0 and 0= \ Keine Nicht-DOS-Kennung (wie etwa 83 bei Linux) if c@ 0f and 10 or \ Unteres Nibble uebernehmen, 1 in oberes Nibble, swap c! \ Ergebnis nach sectbuf (Sektorpuffer) schreiben; else 2drop \ sonst Kennungsadresse aus dem Puffer wegnehmen. then ; \ Partition sichtbar machen. Zunaechst nur in sectbuf (Sektorpuffer). MBR muss \ schon per getmbr in den Puffer geschrieben sein. Zum Wirksamwerdenlassen \ mit putmbr abschliessen! Vorsicht bei der erweiterten Partition! Weiter wie \ bei hidepart. : unhidepart ( n -- ) \ n wird vorsichtshalber auf [1..4] begrenzt. 1 - 3 and 10 * 1c2 + \ n-1 mal Zeilenverschiebung (10h) plus Offset sectbuf + dup dup \ im Puffer (dreimal). c@ f0 and 10 = \ Keine Nicht-DOS-Kennung (wie etwa 83 bei Linux): if c@ 0f and \ Unteres Nibble uebernehmen, 0 in oberes Nibble, swap c! \ Ergebnis nach sectbuf (Sektorpuffer) schreiben; else 2drop \ sonst Kennungsadresse aus dem Puffer wegnehmen. then ; \ Alle Partitionen, auch die erweiterte, verstecken. Alle Vorsichtsmassnahmen \ von hidepart werden uebernommen. Die Bearbeitung findet nur im Sektorpuffer \ sectbuf statt. Der MBR muss vorher per getmbr dorthin gelegt worden sein. Um \ die Aenderungen auf die Festplatte zu bringen, muss dann noch putmbr \ eingesetzt werden. : hideall ( -- ) 4 0 \ 4 zu bearbeitende Zeilen im MBR do i 1 + hidepart loop ; \ Alle Partitionen, mit Ausnahme der erweiterten, verstecken. Ansonsten alles \ wie bei hideall. : hideall-ext ( -- ) 4 0 \ 4 zu bearbeitende Zeilen im MBR do i 3 and 10 * 1c2 + sectbuf + c@ 0f and \ Erweiterte Partition? 05 <> if i 1 + hidepart \ Nein, dann verstecken else i 1 + unhidepart \ Ja, dann 05 in sectbuf schreiben then loop ; \ Partition bootbar machen. Hat natuerlich fuer die erweiterte Partition \ (normalerweise) keinen Sinn. Zunaechst nur in sectbuf (Sektorpuffer). MBR \ muss schon per getmbr in den Puffer geschrieben worden sein. Zum \ Wirksamwerdenlassen mit putmbr abschliessen! : activatepart ( lw n -- ) \ lw = HD-Laufwerk (1...). Keine Begrenzung! swap 7f + swap \ Jetzt lw = 80... . 1 - 3 and 10 * 1be + \ n = Partition. n-1 begrenzt auf [0...3]. sectbuf + c! ; \ In Partitionstabelle (nach sectbuf) schreiben. \ Partition nicht-bootbar machen. Mit deactivateall (siehe gleich) kann man \ die gesamte Festplatte (welche?) ausschalten. Auch bei Linux? : deactivatepart ( n -- ) \ Byte bei Offset 1be in Partitionstabelle auf 0 -7f swap \ setzen: Also keine Laufwerkangabe noetig !?! activatepart swap ; \ Alle Partitionen auf nicht-bootbar (ID = 00) setzen. Nur im Sektorpuffer \ sectbuf. Der MBR muss vorher in den sectbuf geholt werden. Wenn alle weiteren \ Massnahmen erledigt sind, per putmbr auf der Platte wirksam werden lassen! : deactivateall ( -- ) 4 0 \ 4 zu bearbeitende Zeilen im MBR do i 1 + deactivatepart loop ; \ Die im MBR enthaltene Partitionstabelle mit Erlaeuterungen aus dem im \ Forth-Puffer gespeicherten MBR herausholen und am Bildschirm anzeigen. \ Achtung: (showparttab) kuemmert sich nicht darum, ob im Puffer wirklich ein \ Abbild des momentanen (oder wenigstens eines brauchbaren) MBRs liegt. Vor \ Aufruf von (showparttab) muss man den MBR erst per getmbr von der Festplatte \ in den Puffer holen. Das Forth-Wort showparttab (siehe weiter unten im \ vorliegenden Listing) erledigt beides. \ Eine .com-Datei von etwa demselben Funktionsumfang (mit Erlaeuterungen in \ englischer Sprache) wurde mir am 20.12.2003 von Rolf Schoene \ (Forth-Gesellschaft und damals Institut fuer Angewandte Mathematik der \ TU-Muenchen) uebermittelt. Das Vorliegende praesentiert also das Ganze in \ Forth. Schon allein fuer die ueberaus kompakte Moeglichkeit der Darstellung \ in Forth hat sich der mit diesem Artikel verbundene Aufwand (fuer mich) \ gelohnt. : (showparttab) ( -- ) ." MBR-Partitionstabelle (Kopf 0, Spur 0, Sektor 1, Offset 01BE): " cr cr 05 1 do i 30 + emit ." :" space 10 0 do sectbuf 1be + i + 10 j 1 - * + c@ 0 <# # # #> type space loop cr loop 4 spaces 10 0 do b3 emit 2 spaces loop cr 4 spaces 0c 0 do b3 emit 2 spaces loop c0 emit 03 0 do c4 emit c4 emit c1 emit loop 03 0 do c4 emit loop ." Part.-Laenge (in Sektoren)" cr 4 spaces 08 0 do b3 emit 2 spaces loop c0 emit 03 0 do c4 emit c4 emit c1 emit loop 08 0 do c4 emit loop ." Anzahl vorausgegangener Sektoren" cr 4 spaces 07 0 do b3 emit 2 spaces loop c0 emit 15 0 do c4 emit loop ." Nr des letzten Zylinders (0..7)" cr 4 spaces 06 0 do b3 emit 2 spaces loop c0 emit 09 0 do c4 emit loop ." Nr des letzten Sektors (0..5), Zylinder (6..7)" cr 4 spaces 05 0 do b3 emit 2 spaces loop c0 emit 25 0 do c4 emit loop ." Nr des letzten Kopfes" cr 4 spaces 04 0 do b3 emit 2 spaces loop c0 emit ." 01:FAT12, 04:FAT16<32MB, 05:erw.Part., 06:FAT16>32MB, 07:NTFS" cr 4 spaces 03 0 do b3 emit 2 spaces loop c0 emit 22 0 do c4 emit loop ." Nr des ersten Zylinders (0..7)" cr 4 spaces 02 0 do b3 emit 2 spaces loop c0 emit 16 0 do c4 emit loop ." Nr des ersten Sektors (0..5), Zylinder (6..7)" cr 4 spaces 01 0 do b3 emit 2 spaces loop c0 emit 2b 0 do c4 emit loop ." Nr des ersten Kopfes (0..5)" cr 4 spaces c0 emit 08 0 do c4 emit loop ." 80:aktive Primaerpartition (Bootpartition - nur eine!)," ." 00:inaktiv" cr cr ." Achtung: little endian!" cr ." Die vier Bytes " 04 0 do sectbuf 1ca + i + c@ 0 <# # # #> type space loop ." in Zeile 1 stellen die Hexzahl " 04 0 do sectbuf 1ca + 3 + i - c@ 0 <# # # #> type loop ." dar, usw." cr ; : showparttab ( -- ) \ Kommentare siehe (showparttab) getmbr cr cr (showparttab) ; \ Mit dem Booteinrichtungsprogramm n (bootpart) wird die Partitionstabelle im \ Sektorpuffer sectbuf auf das Booten der Partition n vorbereitet. n wird durch \ "wrapping" auf die Werte 1 bis 4 beschraenkt und stellt die Zeile in der \ Partitionstabelle dar, deren Entsprechung gebootet werden soll. Wird \ irrtuemlich ein Booten von der erweiterten Partition (so man eine eingerichtet \ hat) verlangt, so bricht (bootpart) mit einer Fehlermeldung ab und das System \ wartet auf eine neue Eingabe. Bevor (bootpart) vernuenftig arbeiten kann, muss \ der MBR per getmbr in den Sektorpuffer sectbuf geholt worden sein. Damit die \ Neueinstellungen auf die Festplatte geschrieben werden, muss abschliessend \ putmbr eingesetzt werden. \ Vorsicht mit putmbr, wenn man sich nicht ganz sicher ist, ob man das Resultat \ von getmbr fuer den Fall aller Faelle irgendwo abgespeichert hat! : (bootpart) ( n -- ) \ n = Zeile in der Partitionstabelle dup 1 - 3 and 10 * 1c2 + sectbuf + c@ 0f and 05 = if cr ." Erweiterte Partition" drop exit then hideall-ext \ Alle Partitionen, ausser erweiterter, verstecken. deactivateall \ Alle Laufwerke inaktiv setzen 1 over activatepart \ Laufwerk n in Boot-HD aktiv setzen unhidepart \ Laufwerk n in Boot-HD sichtbar machen (showparttab) ; \ Partitionstabelle anzeigen \ Die vorausgegangenen Vorbereitungsschritte werden ueber bootpart zu einem \ einzigen Schritt zusammengefasst. Die neue Partitionstabelle steht dann im \ MBR der Festplatte. Zum endgueltigen Booten muss der Computer dann neu \ gestartet werden. : bootpart ( n -- ) \ Laufwerk n in Boot-HD endgueltig booten getmbr \ MBR in den Puffer sectbuf holen (bootpart) \ Partitionstabelle vorbereiten putmbr ; \ Puffer sectbuf auf Boot-HD zurueckspeichern \ Glossar \ sectbuf ( -- ad) Konstante, Adresse des Sektorpuffers \ (getsect) ( seite spur/sektor -- ) Sektor von HD nach sectbuf holen \ (putsect) ( seite spur/sektor -- ) Sektor von sectbuf nach HD schreiben \ sp,sc>spsc ( sp sc -- spsc ) Spur und Sektor zu 2 Bytes zusammenfassen \ spsc>sp,sc ( spsc -- sp sc ) Umkehrung von sp,sc>spsc \ getmbr ( -- ) 0 1 (getsect) , MBR von HD nach sectbuf holen \ putmbr ( -- ) 0 1 (putsect) , sectbuf als MBR auf HD schreiben \ showsectbuf ( -- ) sectbuf (200 Bytes) anzeigen - egal, was drin \ showsectbuf100 ( -- ) sectbuf (100 Bytes) anzeigen - egal, was drin \ getpart ( n -- s-ad ) Partitionstabelle n von HD nach sectbuf holen \ putpart ( s-ad -- ) Ergebnis von getpart von sectbuf nach HD schreiben \ getboot ( n -- ) Bootsektor des Laufwerks n von HD nach sectbuf holen \ hidepart ( n -- ) Partition n mit Hi-Nibble 1 versehen - nur im sectbuf \ hideall ( -- ) Alle Partitionen im sectbuf mit Hi-Nibble 1 versehen \ hideall-ext ( -- ) Wie hideall, aber erweiterte Partition mit 05 versehen \ unhidepart ( n -- ) Partition n in sectbuf wieder sichtbar machen \ activatepart ( lw n -- ) HD-ID von Part. n von Platte lw auf 80+lw setzen \ deactivatepart ( n -- ) HD-ID von Partition n auf 00 setzen \ deactivateall ( -- ) HD-ID aller Partitionen auf 00 setzen \ (showparttab) ( -- ) MBR-Partitionstabelle aus sectbuf am Monitor anzeigen \ showparttab ( -- ) Wie (showparttab), aber erst MBR von HD nach sectbuf. \ (bootpart) ( n -- ) sectbuf zum Booten von Partition n vorbereiten \ bootpart ( n -- ) MBR auf der HD zum Booten von Partition n vorbereiten \ Ende des Listings