Benutzer-Werkzeuge

Webseiten-Werkzeuge


vd-archiv:listings:4d2008-03-listings

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