vd-archiv:listings:4d2008-03-listings
Inhaltsverzeichnis
4d2008-03 Listings
example.2.4th
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
all_dow31_source_code.fs
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.fs
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
keep-track-of-time.fs
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
bootmast.fs
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
vd-archiv/listings/4d2008-03-listings.txt · Zuletzt geändert: 2017-05-21 21:22 von mka