bootblock.lisp

   1 ;;;;------------------------------------------------------------------
   2 ;;;;
   3 ;;;;    Copyright (C) 2001,2000, 2002-2005,
   4 ;;;;    Department of Computer Science, University of Tromso, Norway
   5 ;;;;
   6 ;;;; Filename:      bootblock.lisp
   7 ;;;; Description:   A simple, single-stage, floppy bootloader.
   8 ;;;; Author:        Frode Vatvedt Fjeld <frodef@acm.org>
   9 ;;;; Created at:    Mon Oct  9 20:47:19 2000
  10 ;;;; Distribution:  See the accompanying file COPYING.
  11 ;;;;
  12 ;;;; $Id: bootblock.lisp,v 1.13 2007/03/16 17:39:27 ffjeld Exp $
  13 ;;;;
  14 ;;;;------------------------------------------------------------------
  15
  16 (in-package movitz)
  17
  18 (defvar *bootblock-build-file* #p"bootblock-id.txt")
  19 (defvar *bootblock-build*
  20     ;; make this variable persistent.
  21     (or (ignore-errors
  22          (with-open-file (s *bootblock-build-file* :direction :input)
  23            (with-standard-io-syntax (read s))))
  24         (warn "Unable to read ~S from ~A, resetting to zero."
  25               '*bootblock-build*
  26               *bootblock-build-file*)
  27         0))
  28
  29 (defvar *floppy-size* (* 512 18 2 80))
  30
  31 (defun make-segment-descriptor-byte (&rest descriptor-args)
  32   (list (complex (binary-types::bitfield-compute-numeric-value
  33                   (find-binary-type 'segment-descriptor)
  34                   (apply #'make-segment-descriptor descriptor-args))
  35                  8)))
  36
  37 (defun mkasm16-bios-print ()
  38   "Print something to the terminal.  [es:si] points to the text"
  39   `((:movzxb (:si) :cx)
  40     (:incw :si)
  41     (:movb #xe :ah)
  42     (:movw 7 :bx)
  43     print-loop
  44     (:lodsb)
  45     (:int #x10)
  46     (:loop 'print-loop)
  47     (:ret)))
  48
  49 (defun mkasm16-format-hex ()
  50   "Format a 16-bit word (in DX) into hex string (in DI)"
  51   `((:std)
  52     (:movw 4 :cx)
  53     (:addw :cx :di)
  54     (:decw :di)
  55     format-loop
  56     (:movb :dl :bl)
  57     (:andw #x0f bx)
  58     (:movb ('hex-table bx) :al)
  59     (:stosb)
  60     (:shrw :dx 4)
  61     (:decw :cx)
  62     (:jnz 'format-loop)
  63     (:cld)
  64     (:ret)
  65     hex-table (% format nil "0123456789abcdef")))
  66
  67 (defconstant +SECTOR-SIZE+ 512)
  68 (defconstant +HEAD+ 0)
  69 (defconstant +TRACK+ 1)
  70 (defconstant +NOSEC+ 2)
  71 (defconstant +DADDR+ 4)
  72 (defconstant +DADDRSEG+ 6)
  73 (defconstant +STARTSEC+ 8)
  74
  75 (defconstant +linear-sector+ -4)
  76 (defconstant +destination+ -8)
  77 (defconstant +sectors-per-track+ -12)
  78 (defconstant +stack-frame-size+ 16)
  79
  80 (defconstant +read-buffer+ #x10000)
  81
  82 (defun mkasm16-bios-bootloader (image-size load-address &optional (skip-sectors 0))
  83   (let* ((first-sector (1+ skip-sectors))
  84          (last-sector (+ first-sector (ceiling image-size +sector-size+)))
  85          (read-buffer-segment (floor +read-buffer+ #x10)))
  86     (ia-x86:read-proglist
  87      `(
  88        (:jmp (:pc+ 0))                  ; some BIOSes might check for this.
  89
  90        ;;
  91        ;; We are running at address #x7c00.
  92        ;;
  93
  94        (:xorw :ax :ax)
  95        (:movw :ax :ds)
  96        (:movw :ax :es)
  97
  98        (:movw #x9000 :ax)
  99        (:movw :ax :ss)
 100        (:movw #xfffc :bp)
 101        (:leaw (:bp ,(- +stack-frame-size+)) :sp)
 102        (:movw 'welcome :si)             ; Print welcome message)
 103        (:call 'print)
 104
 105        ;;
 106        ;; Enable the A20 gate
 107        ;;
 108        (:call 'empty-8042)
 109        (:movb #xd1 :al)
 110        (:outb :al #x64)
 111
 112        (:call 'empty-8042)
 113        (:movb #xdf :al)
 114        (:outb :al #x60)
 115        (:call 'empty-8042)
 116
 117        ;; Poll the floppy's sectors per track
 118
 119        (:movw 5 (:bp ,+sectors-per-track+))
 120        check-geometry
 121        (:incb (:bp ,+sectors-per-track+))
 122        (:jz 'read-error)
 123        (:movw (:bp ,+sectors-per-track+) :cx )
 124        (:movw #x0201 :ax)
 125        (:xorw :dx :dx)
 126        (:movw ,read-buffer-segment :bx)
 127        (:movw :bx :es)
 128        (:xorw :bx :bx)
 129        (:int #x13)                      ; Call BIOS routine
 130        (:testb :ah :ah)
 131        (:jz 'check-geometry)
 132        (:decb (:bp ,+sectors-per-track+))
 133
 134        ;;
 135        ;; Read sectors into memory
 136        ;;
 137
 138        (:movw ,first-sector (:bp ,+linear-sector+))
 139        (:movl ,load-address (:bp ,+destination+))
 140
 141        read-loop
 142
 143        (:cmpw ,last-sector (:bp ,+linear-sector+))
 144        (:jg 'read-done)
 145
 146        (:movw 'track-start-msg :si)     ; Print '(' to screen for each track
 147        (:call 'print)
 148
 149        (:movw (:bp ,+linear-sector+) :ax)
 150        (:movb (:bp ,+sectors-per-track+) :cl)
 151        (:divb :cl :ax)                  ; al=quotient, ah=remainder of :ax/:cl
 152
 153        (:movb :ah :cl)                  ; sector - 1
 154        (:movb :al :dh)
 155        (:andb 1 :dh)                    ; head
 156        (:movb :al :ch)
 157        (:shrb 1 :ch)                    ; track
 158        (:xorb :dl :dl)                  ; drive = 0
 159        (:movw (:bp ,+sectors-per-track+) :ax)
 160        (:subb :cl :al)                  ; number of sectors (rest of track)
 161        (:incb :cl)
 162        (:addw :ax (:bp ,+linear-sector+)) ; update read pointer
 163        (:movw (:bp ,+linear-sector+) :bx) ; subtract some if it's the last track.
 164        (:subw ,last-sector :bx)
 165        (:jc 'subtract-zero-sectors)
 166        (:subw :bx :ax)
 167        (:jz 'read-done)
 168        subtract-zero-sectors
 169        (:movb 2 :ah)
 170
 171        (:movw ,read-buffer-segment :bx)
 172        (:movw :bx :es)
 173        (:xorw :bx :bx)
 174        (:int #x13)                      ; Call BIOS routine
 175
 176        (:jc 'read-error)
 177        (:movzxb :al :ecx)
 178
 179        ;;
 180        ;; Install GS as 4GB segment
 181        ;; http://www.faqs.org/faqs/assembly-language/x86/general/part2/
 182        ;;
 183        (:cli)
 184        (:lgdt ('gdt-addr))              ; load gdt
 185        (:movcr :cr0 :eax)
 186        (:orb 1 :al)
 187        (:movcr :eax :cr0)
 188        (:jmp (:pc+ 0))
 189        (:movw 16 :bx)
 190        (:movw :bx :gs)
 191        (:andb #xfe :al)
 192        (:movcr :eax :cr0)
 193        (:jmp (:pc+ 0))
 194        (:sti)
 195        ;; Completed install GS as 4GB segment.
 196
 197        ;; Copy data to destination
 198        (:shll ,(+ 9 -2) :ecx) ; 512/4 = sector-size/word-size
 199        (:movl ,+read-buffer+ :ebx)
 200        (:movl (:bp ,+destination+) :esi)
 201        (:leal (:esi (:ecx 4)) :edx)
 202
 203        (:movl :edx (:bp ,+destination+))
 204
 205        copy-loop
 206        (:decl :ecx)
 207        ((:gs-override) :movl (:ebx (:ecx 4)) :edx)
 208        ((:gs-override) :movl :edx (:esi (:ecx 4)))
 209        (:jnz 'copy-loop)
 210
 211        (:movw 'track-end-msg :si)       ; Print ')' to screen after each track
 212        (:call 'print)
 213
 214        (:jmp 'read-loop)
 215
 216        read-done
 217
 218        motor-loop                       ; Wait for floppy motor
 219        (:btw 8 (#x43e))
 220        (:jc 'motor-loop)
 221
 222        (movw 'entering :si)             ; Print welcome message
 223        (call 'print)
 224
 225        ;; Read the cursor position into DH (row) and DL (column).
 226        (:movb 3 :ah)
 227        (:movb 0 :bh)
 228        (:int #x10)
 229
 230        (:cli)                           ; Disable interrupts
 231        (:lgdt ('gdt-addr))              ; load gdt
 232
 233        (:xorw :ax :ax)
 234        (:movw :ax :es)                  ; reset es
 235
 236        ;;
 237        ;; Turn off the cursor
 238        ;;
 239
 240 ;;;       (movb #x01 :ah)
 241 ;;;       (movw #x0100 :cx)
 242 ;;;       (int  #x10)
 243
 244
 245        ;;
 246        ;; Load machine status word.  This will enable
 247        ;; protected mode.  The subsequent instruction MUST
 248        ;; reload the code segment register with a selector for
 249        ;; the protected mode code segment descriptor (see
 250        ;; GDT specification).
 251        ;;
 252        (:movw 1 :ax)
 253        (:lmsw :ax)                      ; load word 0 of cr0
 254
 255        ;;
 256        ;; Do a longjump to new-world.  This will cause the CS to
 257        ;; be loaded with the correct descriptor, and the processor
 258        ;; will now run in 32 bit mode.
 259        ;;
 260
 261        (:jmp 8 ('new-world))
 262
 263        ;;
 264        ;; Display error message and hang
 265        ;;
 266        read-error
 267        (:movw 'error :si)               ; Print error message
 268        (:call 'print)
 269        halt-cpu
 270        (:halt)
 271        (:jmp 'halt-cpu)                 ; Infinite loop
 272
 273        ;;
 274        ;; Empty the 8042 Keyboard controller
 275        ;;
 276        empty-8042
 277        (:call 'delay)
 278        (:inb #x64 :al)                  ; 8042 status port
 279        (:testb 1 :al)                   ; if ( no information available )
 280        (:jz 'no-output)                 ;   goto no_output
 281        (:call 'delay)
 282        (:inb #x60 :al)                  ; read it
 283        (:jmp 'empty-8042)
 284        no-output
 285        (:testb 2 :al)                   ; if ( input buffer is full )
 286        (:jnz 'empty-8042)               ;   goto empty_8042
 287        (:ret)
 288
 289        delay
 290        (:xorw :cx :cx)
 291        delay-loop
 292        (:loop 'delay-loop)
 293        (:ret)
 294
 295        print ,@(mkasm16-bios-print)
 296
 297        ;; Data
 298        welcome         (% format 8 "Loading Movitz ~D..~%
"
 299                           ,(incf *bootblock-build*))
 300        entering        (% format 8 "~%
Enter..")
 301        error           (% format 8 "Failed!)")
 302        track-start-msg (% format 8 "(")
 303        track-end-msg   (% format 8 ")")
 304        sector-msg      (% format 8 "-")
 305
 306        (% align 16)
 307        gdt
 308        (% bytes 16 0)
 309        gdt-addr
 310        (% bytes 16 ,(1- (* 3 8))) (% bytes 32 'gdt) ; both the null and pointer to gdt
 311        ;; (% fun (make-segment-descriptor-byte)) ; dummy null descriptor
 312        (% fun (make-segment-descriptor-byte :base 0 :limit #xfffff ; 1: code segment
 313                                             :type 10 :dpl 0
 314                                             :flags (s p d/b g)))
 315        (% fun (make-segment-descriptor-byte :base 0 :limit #xfffff ; 2: data segment
 316                                             :type 2 :dpl 0
 317                                             :flags (s p d/b g)))
 318        ;; (% align 4)
 319        new-world
 320        ;; ..must be concatenated onto here.
 321        ))))
 322
 323
 324
 325
 326
 327 (defconstant +screen-base+ #xb8000)
 328 (defparameter +message+ "Ok.")
 329 (defparameter +halt-message+ "Halt!")
 330
 331 (defun make-vga-string (string)
 332   (loop for char across string
 333       collect (complex (logior #x0700 (char-code char)) 2)))
 334
 335 (defun mkasm-loader (image-size load-address call-address)
 336   "Make the 32-bit loader."
 337   (assert (<= load-address call-address (+ load-address image-size)) ()
 338     "Call-address #x~X is not in range #x~X to #x~X."
 339     call-address load-address (+ load-address image-size))
 340   (ia-x86:read-proglist
 341    `(
 342      ;;
 343      ;; Load DS, ES and SS with the correct data segment descriptors
 344      ;;
 345      (:movw ,(* 2 8) :ax)
 346      (:movw :ax :ds)
 347      (:movw :ax :es)
 348      (:movw :ax :fs)
 349      (:movw :ax :gs)
 350      (:movw :ax :ss)
 351
 352      (movl #x20000 :esp)
 353 ;;;     (pushl -1)                              ; stack-end-marker
 354
 355      ;; If we are not on a 386, perform WBINVD to flush caches.
 356      ;; (:testl :edi :edi)                      ; clear ZF
 357      (:pushfl)                          ; push original EFLAGS
 358      (:popl :eax)                       ; get original EFLAGS
 359      (:movl :eax :ecx)                  ; save original EFLAGS
 360      (:xorl #x40000 :eax)               ; flip AC bit in EFLAGS
 361      (:pushl :eax)                      ; save new EFLAGS value on stack
 362      (:popfl)                           ; replace current EFLAGS value
 363      (:pushfl)                          ; get new EFLAGS
 364      (:popl :eax)                       ; store new EFLAGS in EAX
 365      (:xorl :ecx :eax)                  ; can't toggle AC bit, processor=80386, ZF=1
 366      (:jz 'skip-wbinvd)                 ; jump if 80386 processor
 367      (:wbinvd)
 368      skip-wbinvd
 369
 370      (:movzxb :dl :eax)                 ; cursor column
 371      (:movzxb :dh :ebx)                 ; cursor row
 372
 373      (:imull 160 :ebx :ebx)
 374      (:movl 'i-am-32 :esi)
 375
 376      os-loop
 377      (:leal ((:eax 2) :ebx ,+screen-base+) :edi)
 378      (:xorl :ecx :ecx)
 379      (:movb ,(length +message+) :cl)
 380      ((:repz) :movsw)                   ; print i-am-32
 381
 382      (:movl ,call-address :eax)
 383      (:jmp :eax)                        ; call OS
 384
 385 ;;;     (:movl ,(length +halt-message+) :ecx)
 386 ;;;     (:movl 'halt-msg :esi)
 387 ;;;     (:movl ,(+ +screen-base+ (* 2 80 11) (* 2 35)) :edi)
 388 ;;;     ((:repz) movsw)
 389 ;;;
 390 ;;;     (:movw #x7400 (:edi))
 391 ;;;     eternal
 392 ;;;     (:incb (:edi))
 393 ;;;     (:halt)
 394 ;;;     (:jmp 'eternal)                 ; OS returned?
 395      ;; (% align 2)
 396      i-am-32 (% fun (make-vga-string ,+message+))
 397 ;;;     halt-msg (% fun ((lambda ()
 398 ;;;                     (loop for char across ,+halt-message+
 399 ;;;                         collect (complex (logior #x4700 (char-code char)) 2)))))
 400      )))
 401
 402 (defun make-bootblock (image-size load-address call-address
 403                        &key (skip-sectors 0) (include-records))
 404   (when *floppy-size*
 405     (let ((floppy-room (- *floppy-size* 512))) ; Size of floppy minus the bootloader.
 406       (if (> image-size floppy-room)
 407           (warn "The image is ~D bytes too big to fit on a ~,2F MB floppy."
 408                 (- image-size floppy-room)
 409                 (/ *floppy-size* (* 1024 1000)))
 410           (format t "~&;; Bootloader has room for ~,1F KB more."
 411                   (/ (- floppy-room image-size) 1024)))))
 412   (multiple-value-bind (bios-loader bb-symtab)
 413       (ia-x86:proglist-encode :octet-vector :16-bit #x7c00
 414                               (mkasm16-bios-bootloader image-size load-address skip-sectors))
 415     (multiple-value-bind (protected-loader protected-symtab)
 416         (ia-x86:proglist-encode :octet-vector
 417                                 :32-bit
 418                                 (ia-x86:symtab-lookup-label bb-symtab
 419                                                             'new-world)
 420                                 (mkasm-loader image-size load-address call-address))
 421       (let* ((loader-length (+ (length bios-loader) (length protected-loader)))
 422              (bootblock (progn
 423                           (assert (<= loader-length 510) ()
 424                             "Bootblock size of ~D octets is too big, max is 510!" loader-length)
 425                           (make-array 512 :element-type '(unsigned-byte 8)
 426                                       :fill-pointer loader-length))))
 427         (setf (subseq bootblock 0) bios-loader
 428               (subseq bootblock (length bios-loader)) protected-loader)
 429         (loop until (zerop (mod (fill-pointer bootblock) 4))
 430             do (vector-push 0 bootblock))
 431         (dolist (record include-records)
 432           (let ((*endian* :little-endian))
 433             (with-binary-output-to-vector (stream bootblock)
 434               (write-binary-record record stream))))
 435         (setf (fill-pointer bootblock) 512
 436               (subseq bootblock 510) #(#x55 #xaa)) ; bootblock signature
 437         (format t "~&;; Bootblock size is ~D octets.~%" loader-length)
 438         (format t "~&;; Bootblock build ID: ~D.~%" *bootblock-build*)
 439         (with-open-file (s #p"bootblock-id.txt"
 440                          :direction :output
 441                          :if-exists :supersede)
 442           (with-standard-io-syntax
 443             (write *bootblock-build* :stream s)))
 444         (values bootblock (append bb-symtab protected-symtab))))))
 445