[syslinux] Conditional kernel selection based on CPUID/DMI info

Jeffrey Hutzelman jhutz at cmu.edu
Tue Jan 29 13:01:10 PST 2008


--On Tuesday, January 29, 2008 12:05:52 PM -0800 "H. Peter Anvin" 
<hpa at zytor.com> wrote:

> Craig Johnston wrote:
>>
>> What do people think of the following for a string substitution method?
>>
>> DEFAULT linux
>>
>> LABEL linux
>>     KERNEL cpuselect.c32
>>     APPEND ${LM?"x86_64":"i386"}/bzImage-${SMP?"smp":"up"}
>> initrd=${LM?"x86_64":"i386"}/initrd-${SMP?"smp":"up"} console=ttyS0
>>
>> LABEL linux-single
>>     KERNEL cpuselect.c32
>>      APPEND ${LM?"x86_64":"i386"}/bzImage-${SMP?"smp":"up"}
>> initrd=${LM?"x86_64":"i386"}/initrd-${SMP?"smp":"up"} console=ttyS0
>> single
>>
>> The parameters "LM" and "SMP" are Boolean values that are set in the
>> cpuselect.c32 module, and select the replacement text ala the C-like
>> conditional statement.  This is just one of many ways to do something
>> like this, and it would seem a lot simpler than a full fledged
>> scripting language (it's all kept inside a module).
>>
>> Am I reinventing the wheel here, or inventing a square wheel?  :)
>>
>
> I think we can consider a pattern-substitution module to be the
> beginning of a scripting language.  We should probably have it collect
> information from as many sources as possible (CPUID, ...)
>
> On the other hand, a fullblown scripting language probably would be easy
> enough -- it's not really any different than what you're doing above.
> It's just a matter of having the time to do it...

I've been meaning to send in a couple of things I wrote in the last few 
weeks which might be relevant.

The first is lmcheck.asm, which is another variation on the usual 32/64 
check.  This one runs one of two labels (currently 'linux32' or 'linux64') 
depending on whether we detect a 64-bit CPU, and passes along whatever 
arguments were given to it.  We use it with configuration like this:


label linux
  kernel lmcheck.cbt
label linux32
  kernel vmlinuz.32
  append initrd=initrd32.img  ks=nfs:server:/path
label linux64
  kernel vmlinuz.64
  append initrd=initrd64.img  ks=nfs:server:/path


The second is bioschk.asm, which started out as a way to check for a 
particularly annoying BIOS (Dell Optiplex GX620 version A11, on which USB 
keyboard emulation breaks apparently on entering 32-bit protected mode).
I decided early that it should be configurable, and ended up writing a 
scripting language complete with branching, limited user input, and the 
ability to boot things.  I've attached just the source, but there's also a 
test suite.

-- Jeff
-------------- next part --------------
; "$Id: lmcheck.asm,v 1.2 2006/07/29 01:30:01 jhutz Exp $"
; vi:set noet:

; Copyright (c) 2006 Carnegie Mellon University
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License, Version 2,
; as published by the Free Software Foundation.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

; %define DEBUG
; %define NO_RUN

		absolute 0
pspInt20:	resw 1
pspNextP:	resw 1
		resb 124
pspCmdLen:	resb 1
pspCmdArg:	resb 127

		section .text
		org 0x100

; -----------------------------------------------------------------------
; check for long mode, modified from linux/arch/x86_64/boot/setup.S
; setup.S         Copyright (C) 1991, 1992 Linus Torvalds
; -----------------------------------------------------------------------

; minimum CPUID flags for x86-64
; see http://www.x86-64.org/lists/discuss/msg02971.html
SSE_MASK	equ	0x06000000  ; bits 25, 26
REQUIRED_MASK1	equ	0x0100A179  ; bits 0, 3, 4, 5, 6, 8, 13, 15, 24
REQUIRED_MASK2	equ	0x20000000  ; bit 29


check_longmode:
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_hello
		int	0x22
		;mov	si,msg_no_cpuid
%endif
		pushfd				; standard way to
		pop	eax			; check for cpuid
		mov	ebx,eax
		xor	eax,0x200000
		push	eax
		popfd
		pushfd
		pop	eax
		cmp	eax,ebx
		jz	near no_longmode	; cpu has no cpuid
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_cpuid_ok
		int	0x22
		mov	si,msg_no_cpuid1
%endif
		mov	eax,0x0
		cpuid
		cmp	eax,0x1
		jb	near no_longmode	; no cpuid 1
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_cpuid1_ok
		int	0x22
		mov	eax,0x0
		cpuid
%endif
		xor	di,di
		cmp	ebx,0x68747541		; AuthenticAMD
		jnz	noamd
		cmp	edx,0x69746e65
		jnz	noamd
		cmp	ecx,0x444d4163
		jnz	noamd
		mov	di,1			; cpu is from AMD
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_cpu_amd
		int	0x22
		jmp	isamd
%endif
noamd:
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_not_amd
		int	0x22
isamd:
		mov	si,msg_mask1_bad
%endif
		mov	eax,0x1
		cpuid
		and	edx,REQUIRED_MASK1
		xor	edx,REQUIRED_MASK1
		jnz	near no_longmode
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_mask1_ok
		int	0x22
		mov	si,msg_no_cpuidx1
%endif
		mov	eax,0x80000000
		cpuid
		cmp	eax,0x80000001
		jb	near no_longmode	; no extended cpuid
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_cpuidx1_ok
		int	0x22
		mov	si,msg_mask2_bad
%endif
		mov	eax,0x80000001
		cpuid
		and	edx,REQUIRED_MASK2
		xor	edx,REQUIRED_MASK2
		jnz	no_longmode
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_mask2_ok
		int	0x22
		mov	si,msg_no_sse
%endif
sse_test:
		mov	eax,1
		cpuid
		and	edx,SSE_MASK
		cmp	edx,SSE_MASK
		je	longmode_ok
		test	di,di
		jz	no_longmode		; only try to force SSE on AMD
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_sse_amd
		int	0x22
%endif
		mov	ecx,0xc0010015
		rdmsr
		btr	eax,15			; enable SSE
		wrmsr
		xor	di,di			; don't loop
		jmp	sse_test		; try again

no_longmode:
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,si
		int	0x22
		mov	ax,0x0002
		mov	bx,msg_32bit
		int	0x22
%endif
		mov	si,cmd_32
		mov	cx,cmd_32_end-cmd_32
		jmp	do_cmd

longmode_ok:
%ifdef DEBUG
		mov	ax,0x0002
		mov	bx,msg_64bit
		int	0x22
%endif
		mov	si,cmd_64
		mov	cx,cmd_64_end-cmd_64

do_cmd:
		; copy the command and arguments into place
		cld
		mov	di,cmdline
		rep movsb
		xor	cx,cx
		mov	si,pspCmdArg
		mov	cl,[pspCmdLen]
		rep movsb
		mov	byte [di],0		; null terminator

		; print it out for the user
		mov	ax,0x0002
		mov	bx,cmdline
		int	0x22
		mov	ax,0x0200
		mov	dl,0x0d
		int	0x21
		mov	ax,0x0200
		mov	dl,0x0a
		int	0x21

%ifndef NO_RUN
		; try to run the command
		mov	ax,0x0003
		mov	bx,cmdline
		int	0x22

		;; if we get here, something went wrong!
		mov	ax,0002
		mov	bx,msg_fail
		int	0x22
%endif
		ret

		section .data
cmd_32:		db 'linux32'
cmd_32_end:
cmd_64:		db 'linux64'
cmd_64_end:
msg_hello:	db 'Hello There',0x0d,0x0a,0
msg_no_cpuid:	db 'CPUID unsupported',0x0d,0x0a,0
msg_cpuid_ok:	db 'CPUID is supported',0x0d,0x0a,0
msg_no_cpuid1:	db 'CPUID level 1 unsupported',0x0d,0x0a,0
msg_cpuid1_ok:	db 'CPUID level 1 is supported',0x0d,0x0a,0
msg_cpu_amd:	db 'CPU is AuthenticAMD',0x0d,0x0a,0
msg_not_amd:	db 'CPU is not from AMD',0x0d,0x0a,0
msg_mask1_bad:	db 'CPUID level 1 feature missing',0x0d,0x0a,0
msg_mask1_ok:	db 'CPUID level 1 features OK ',0x0d,0x0a,0
msg_no_cpuidx1:	db 'CPUID extended level 1 unsupported',0x0d,0x0a,0
msg_cpuidx1_ok:	db 'CPUID extended level 1 is supported',0x0d,0x0a,0
msg_mask2_bad:	db 'CPUID extended level 1 feature missing',0x0d,0x0a,0
msg_mask2_ok:	db 'CPUID extended level 1 features OK',0x0d,0x0a,0
msg_no_sse:	db 'SSE unsupported',0x0d,0x0a,0
msg_sse_amd:	db 'Attempting to force SSE (AMD CPU)',0x0d,0x0a,0
msg_32bit:	db '32-bit CPU detected',0x0d,0x0a,0
msg_64bit:	db '64-bit CPU detected',0x0d,0x0a,0
msg_fail:	db 'lmcheck: command failed',0x0d,0x0a,0
		section .bss
cmdline:	resb 256
-------------- next part --------------
; "$Id: bioschk.asm,v 1.33 2008/01/09 12:51:18 jhutz Exp $"
; -*- fundamental -*- (asm-mode sucks, per hpa)  vim:noet:com=\:;
; ****************************************************************************
; Copyright (c) 2007 Carnegie Mellon University
; All Rights Reserved.
; 
; Permission to use, copy, modify and distribute this software and its
; documentation is hereby granted, provided that both the copyright
; notice and this permission notice appear in all copies of the
; software, derivative works or modified versions, and any portions
; thereof, and that both notices appear in supporting documentation.
; 
; CARNEGIE MELLON ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS"
; CONDITION.  CARNEGIE MELLON DISCLAIMS ANY LIABILITY OF ANY KIND FOR
; ANY DAMAGES WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE.
; 
; Carnegie Mellon requests users of this software to return to
; 
;  Software Distribution Coordinator  or  Software_Distribution at CS.CMU.EDU
;  School of Computer Science
;  Carnegie Mellon University
;  Pittsburgh PA 15213-3890
; 
; any improvements or extensions that they make and grant Carnegie Mellon
; the rights to redistribute these changes.

; ****************************************************************************
;; bioschk.asm
;;
;; A comboot program to check for various potential BIOS problems, and
;; Do Something(tm) about them.  It is invoked with a single argument
;; which is the name of its configuration file.
;;
;; The configuration file consists of blank lines, comments (starting
;; with #), and commands.  Except for CRLF and ^Z, all control characters
;; are treated as whitespace.
;;

Version		equ	0x01000000	; 1.0.0000

;%define DEBUG
;%define NO_RUN

%define Timeout 10

%ifdef NO_REALLY_RUN
%undef NO_RUN
%endif

; ****************************************************************************
; Debugging Macros
; ****************************************************************************
;
; These preserve all registers and flags

%ifdef DEBUG
; Print a literal string, followed by a space
%macro MARK 1+.nolist
  [section .strings]
  %%str: db %1,' ',0

  __SECT__
  pushf
  push ax
  push dx
  push si
  mov si,%%str
  call print_str
  pop si
  pop dx
  pop ax
  popf
%endmacro

; Print an 8-bit value in hex, followed by a space
%macro SHOWB 1.nolist
  pushf
  push ax
  push bx
  push dx
  mov al,%1
  call print_byte
  mov ah,0x02
  mov dl,' '
  int 0x21
  pop dx
  pop bx
  pop ax
  popf
%endmacro

; Print a 16-bit value in hex, followed by a space
%macro SHOWW 1.nolist
  pushf
  push ax
  push bx
  push dx
  mov ax,%1
  call print_word
  mov ah,0x02
  mov dl,' '
  int 0x21
  pop dx
  pop bx
  pop ax
  popf
%endmacro

; Print a 32-bit value in hex, followed by a space
%macro SHOWD 1.nolist
  pushf
  push eax
  push bx
  push dx
  mov eax,%1
  call print_dword
  mov ah,0x02
  mov dl,' '
  int 0x21
  pop dx
  pop bx
  pop eax
  popf
%endmacro

; Print a literal label and a NUL-terminated string on a separate line
%macro SHOWSTR 2.nolist
  [section .strings]
  %%str: db 0x0d,0x0a,%1,' ',0xb0,0

  __SECT__
  pushf
  push ax
  push dx
  push si
  push es
  push ds
  pop es
  mov si,%2
  push si
  mov si,%%str
  call print_str
  pop si
  call print_str
  mov si,EndCRLF
  call print_str
  pop es
  pop si
  pop dx
  pop ax
  popf
%endmacro

; Print a NUL-terminated string and a CRLF
%macro SHOWSTR 1.nolist
  pushf
  push ax
  push dx
  push si
  push es
  push ds
  pop es
  mov si,%1
  mov dl,0xb0
  mov ah,0x02
  int 0x21
  call print_str
  mov si,EndCRLF
  call print_str
  pop es
  pop si
  pop dx
  pop ax
  popf
%endmacro

%else
; if debugging is disabled, these all do nothing
%macro MARK 1+.nolist
%endmacro
%macro SHOWB 1.nolist
%endmacro
%macro SHOWW 1.nolist
%endmacro
%macro SHOWD 1.nolist
%endmacro
%macro SHOWSTR 1-2.nolist
%endmacro
%endif

%ifdef NO_RUN
%define RUN clc
%else
%define RUN int 0x22
%endif

; ****************************************************************************
; Not for debugging, but useful nonetheless
%macro FAIL 1
  [section .strings]
  %%str:
  %ifdef DEBUG
    db 'Fail ',0x0d,0x0a
  %endif
  db 'bioschk: ',%1,0x0d,0x0a,0

  ; if the size of this changes, go fix the table in .compare
  __SECT__
  mov si,%%str		; 3 bytes
  jmp near fail		; 3 bytes
%endmacro

%macro FAIL 2
  j%-1 %%skip
  FAIL %2
  %%skip:
%endmacro

; ****************************************************************************
; Command Table
; ****************************************************************************
;
; These macros are for constructing the command table.
; The approach of using hashes to match command keywords is borrowed from
; SYSLINUX, as is the hash function itself (but no code).
;
; The _cmdhash macro computes the hash for a given keyword, and leaves
; it in a single-line macro called "_hash".
;
; The Command macro is used to start each command.  It takes two arguments:
; the string naming the command and an optional flag word, which defaults
; to zero (this is currently used only to flag conditional commands so that
; single-line ELSE can treat them specially).  It adds the command to the
; command table and emits a command routine header block.
;
; The cmphash macro defines a new pseudo-instruction which works like
; 'cmp', except that the second argument is a string whose hash is used
; for the comparison.

%macro _cmdhash 1.nolist
  %strlen _len %1
  %assign _i 0
  %assign _hash 0
  %rep _len
    %assign _i _i+1
    %substr _c %1 _i
    %assign _hash (((_hash << 5) | (_hash >> 27)) & 0xffffffff) ^ (_c | 0x20)
  %endrep
%endmacro

%macro Command 1-2.nolist 0
  _cmdhash %1

  [section .cmdtable]
  dd _hash
  dw cmd%%exec
  dw %2

  __SECT__
%ifdef DEBUG
  ; make it easier to find a command routine in the binary by
  ; searching for the hash code, and to find or identify a
  ; command routine by name.  The leading NUL byte on the name
  ; is to enable introspection; debugging code converts a
  ; command hash to a string by looking it up in the table,
  ; finding the address of the routine, and searching backward
  ; for this leading NUL.
  dd 0xefbeadde, _hash
  db 0,%1,0
%endif
  cmd%%exec:
  MARK 'CMD:',%1
%endmacro

%macro cmphash 2
  _cmdhash %2
  cmp %1,_hash
%endmacro


; ****************************************************************************
; The PSP provided by SYSLINUX
; ****************************************************************************

                absolute 0
pspInt20:       resw    1
pspNextP:       resw    1
                resb    124
pspCmdLen:      resb    1
pspCmdArg:      resb    127


; ****************************************************************************
; Main Program
; ****************************************************************************

                section .text
                org     0x100

_start:
		cld
		MARK 'Hello'

		; Compute the maximum config file size we can handle
		mov bp,[pspNextP]
		SHOWW cs
		SHOWW bp
		mov ax,cs		; pspNextP - CS is the number of
		sub bp,ax		; paragraphs we have to work with.
		cmp bp,0xfff		; Clip that to 0xfff,
		jbe .noclip
		mov bp,0xfff
.noclip:	shl bp,4		; shift left 4 bits,
		add bp,0x0f		; and add 0xff, and it is available
		SHOWW bp		; bytes reachable via NEAR pointers.
		sub bp,ConfigBuf	; Subtract ConfigBuf to get
		SHOWW bp		; ... the maximum config file size
		; BP has the max config file size
		; all other registers are unused

		; skip leading whitespace
		xor cx,cx
		mov cl,[pspCmdLen]
		mov di,pspCmdArg
		mov al,' '
		repz scasb
		FAIL z,'usage: bioschk.cbt config_file'
		dec di
		mov si,di

		; skip trailing whitespace
		add di,cx		; DI now points at last char
		std
		repz scasb
		cld
		jz .empty		; if Z, there were _no_ non-spaces
		inc di			; else, di points before the last one

.empty:		; NUL-terminate and we're good to go
		mov byte [di+1],0
		; SI points at the NUL-terminated config file path
		; BP has the max config file size
		; all other registers are unused

; ****************************************************************************
		SHOWSTR 'Config',si

		; Open the file
		mov ax,0x0006
		int 0x22
		FAIL c,'Unable to open config file'
		MARK 'Open'
		SHOWD eax
		SHOWW cx

		push eax
		pop ax
		pop dx

		and dx,dx
		jnz .toobig
		cmp ax,bp
		jna .sizeok
.toobig:	FAIL 'Config file is too big'
.sizeok:
		mov bp,ax

		div cx
		and dx,dx
		jz .exact
		inc ax

.exact:		; SI has the config file handle
		; CX has the number of blocks to read
		; all other registers are unused
		;
		; Do the read
		mov cx,ax
		mov bx,ConfigBuf
		mov ax,0x0007
		int 0x22
		FAIL c,'Unable to read config file'
		MARK 'Read'
		; no need to close; if it succeeded then we hit EOF
		; and the file was closed automatically.
		mov byte [bp+ConfigBuf],0
		mov si,ConfigBuf

; ****************************************************************************
; This is the main loop that processes the config file.  It is entered
; with FoundEOL set to 1 and SI pointing at the first character in the
; config buffer.  After each command is processed, control returns
; to .nextline, where we skip any remaining characters on the current
; line before proceeding to the next.
;
; From now on, SI always points to the next usable character in the
; config buffer, and the direction flag is clear, so we can use lodsb.
; Of course, these rules can be temporarily ignored as long as getchar
; is not called, but they must be restored by the time we get to the
; top of this main loop.
;
; There are no other global invariants; in particular, command routines
; are free to use any other general-purpose register for any purpose.

.nextline:
		btr word [FoundEOL],0	; if we already skipped the EOL
		jc .start		; go directly to the next line
.findsol:	lodsb
		cmp al,0x0a
		je .start
		cmp al,0x0d
		je .start		; If it was EOL, start the next line
		cmp al,0
		je .eof
		cmp al,0x1a
		jne .findsol		; If not EOL or EOF, keep looking
.eof:		MARK '<EOF>'
		jmp exit		; EOF means we're done!

.start:
		MARK 0x0d,0x0a,'ReadLine'
		mov edx,0
		call skipspace		; get first non-whitespace
		jc .nextline		; at EOL, skip to next line

.hash:		or al,0x20		; downcase
		rol edx,5
		xor dl,al
		call getchar
		jnz .hash
		SHOWD edx		; command keyword hash

		mov ax,0x13		; idle before processing each command
		int 0x22		; (maybe that's too often; too bad)

		mov al,[SkipMode]
		SHOWB al
		test al,0x7f
		jz .skip0		; mode 0 - normal processing

%ifdef DEBUG
		; print the name of the command we're skipping
		push ax
		push si
		push dx
		push dx
		mov si,msg_skip
		call print_str
		pop dx
		mov si,msg_unknown
		call findcmd
		jc .skipunknown
		call lookup_cmd_str
.skipunknown:
		call print_str
		pop dx
		pop si
		pop ax
%endif
		dec al
		jz .skip1		; mode 1 - skip to ELSE,ENDC,BLOCK
		dec al
		jz .skip2		; mode 2 - skip to ENDC,BLOCK
		dec al
		jz .skip3		; mode 3 - skip to BLOCK
		jmp .skip4		; mode 4: skip-to-label

.skip1:		cmphash edx,'else'	; if we find an ELSE...
		jne .skip2
		mov byte [SkipMode],0	; stop skipping
		jmp .start		; and parse the argument as a command
.skip2:		cmphash edx,'endc'	; stop if we find an ENDC
		je .endskip
.skip3:		cmphash edx,'block'	; stop if we find a BLOCK
		jne .nextline		; otherwise, go to the next line
.endskip:	mov byte [SkipMode],0	; stop skipping
		jmp .nextline		; and move on to the next line


.skip0:		call findcmd
		FAIL c,'Unknown command in config file'

.docmd:		test byte [SkipMode],0x80
		jz .execcmd
%ifdef DEBUG
		push si
		call lookup_cmd_str
		call print_str
		pop si
%endif
		test word [di+2],1
		jz .endskip		; not conditional => we're done
		; since the subcommand is a conditional, go to skipmode 2
		mov byte [SkipMode],2
		jmp .nextline

.skip4:
		cmphash edx,'block'
		je .skiplabel
		cmphash edx,'label'
		jne .nextline
.skiplabel:
		mov di,SkipLabel
		mov cx,[SkipLen]
		call skipspace		; get first non-whitespace

.skipcmp:
		; CX is always nonzero here, so if Z is set (no character)
		; then we hit the end of the label in the command before
		; we hit the end of the label we're looking for, and it is
		; therefore not a match.
		jz .nextline
		scasb			; if the two characters are not
		jnz .nextline		; the same, it is also not a match
		call getchar
		loop .skipcmp
		; CX is always zero here, so if Z is not set (we got a
		; character) then we hit the end of the label we're looking
		; for before we hit the end of the label in the command,
		; and it is therefore not a match.
		jnz .nextline

		; If we get here, we hit the ends of both labels at the
		; same time, and it is a match.  Stop skipping and move on.
		jmp .endskip

.execcmd:
		call [di]
		FAIL c,'Syntax error in config file'
		test byte [SkipMode],0x80
		jz .nextline

		; We are here because the ELSE command just set skipmode 0x80,
		; and we need to process its subcommand.  It has already
		; loaded the first character of the command into AL, so we
		; need to initialize the command hash and then jump into the
		; code that constructs its value.
		xor edx,edx
		jmp .hash

; Search the command table for the command whose hash is in EDX.
; On success, points DI at the command data and clears carry.
; On failure, destroys DI and sets carry.
; In either case, EAX and CX are destroyed.
findcmd:
		mov eax,edx
		mov di,CommandTable
		mov cx,NumCommands
.scan:		scasd
		jz .found
		add di,4
		loop .scan
		stc
.found:		ret

%ifdef DEBUG
; given DI points at data in the command table (past the hash),
; find the string embedded before the command routine, and make
; SI be a pointer to it.  Destroys AX and flags.
lookup_cmd_str:
		; print the name of the command we're skipping
		mov si,[di]
		xchg si,di
		sub di,2
		std
		xor al,al
.lookback:	scasb
		jnz .lookback
		cld
		lea di,[di+2]
		xchg si,di
		ret
%endif


; ****************************************************************************
; Input Routines
; ****************************************************************************

; Get the next character in the config buffer and return it in AL.
; If the fetched character is whitespace, the zero flag is set.
; If the fetched character is EOL or EOF, the zero and carry
; flags are set, and the file pointer is not advanced (so future
; calls return the same result).
; Otherwise Z and C are both cleared.
getchar:	lodsb
		cmp al,0		; EOF
		je .eol
		cmp al,0x1a		; EOF
		je .eol
		cmp al,0x0a		; EOL
		je .eol
		cmp al,0x0d		; EOL
		je .eol
		cmp al,'#'		; EOL
		je .eol
		cmp al,' '		; WHITESPACE
		ja .normal		; Z and C already clear
		cmp al,al		; set Z, clear C
.normal:	ret

.eol:		dec si			; don't advance past EOL
		cmp al,al		; set Z
		stc
		ret


; Read characters from the config buffer until EOL or a non-whitespace
; is found.  Returns the last-read character in AL, with both the carry
; and zero flags set if EOL was encountered.
skipspace:	call getchar
		jc .eol
		jz skipspace
.eol:		ret


; Read a numeric argument from the config buffer, in decimal or hex, and
; return it in EAX.  If the next word is not a valid number, or there is
; nothing to read, the carry flag is set.  Arithmetic flags are destroyed;
; all other registers are preserved.
; 
; The special entry point getnumber.special is used by getcompare, below,
; when the first character has already been loaded into EAX.
getnumber:
		xor eax,eax		; keep eax==al
		call skipspace
.special:	push ebx
		xor ebx,ebx		; accumulator
		jc .eol
		cmp al,'$'
		je .hex
		cmp al,'0'
		jnz .integer
		call getchar
		jz .done
		cmp al,'X'
		je .hex
		cmp al,'x'
		je .hex

.integer:	cmp al,'9'
		ja .bogus
		sub al,'0'
		jb .bogus
		imul ebx,10
		add ebx,eax
		call getchar
		jnz .integer

.done:		clc
.eol:		mov eax,ebx
		pop ebx
		ret

.bogus:		stc
		jmp .eol

.hex:		call getchar
		jz .done
		cmp al,'9'
		ja .xdigit
		sub al,'0'
		jb .bogus
.xadd:		shl ebx,4
		or bl,al
		jmp .hex

.xdigit:	or al,0x20
		cmp al,'f'
		ja .bogus
		cmp al,'a'
		jb .bogus
		sub al,'a'-10
		jmp .xadd


; Read a real-mode address from the config buffer, in decimal or hex, and
; return it in ES:DI.  EAX is destroyed.  If the next word is not a valid
; address, or there is nothing to read, the carry flag is set.  EAX and
; arithmetic flags are destroyed; all other registers are preserved.
getaddr:
		call getnumber
		jc .done
		SHOWD eax
		cmp eax,0xfffff
		ja .fail
		mov di,ax
		shr eax,4
		and ax,0xf000
		mov es,ax
%ifdef DEBUG
  push bx
  push dx
  mov ax,es
  call print_word
  mov ah,0x02
  mov dl,':'
  int 0x21
  mov ax,di
  call print_word
  mov ah,0x02
  mov dl,' '
  int 0x21
  pop dx
  pop bx
%endif
.done:		ret
.fail:		stc
		ret


; Read a word; that is, a sequence of one or more non-whitespace characters.
; Returns a pointer to the string in BX, its length in CX, and arranges for
; it to be NUL-terminated.
getword:
		call skipspace
		jc getstring.eol
		lea cx,[si-1]		; point CX at the start

.scan:		call getchar
		jnz .scan
		lea bx,[si-1]		; point BX at the separator
		adc bx,0		; at EOL, include the last character
		jmp getstring.terminate

; Read a string; that is, a sequence of characters that starts with the
; first non-whitespace character and continues to the last non-whitespace
; character on the line.  Returns a pointer to the string in BX, its length
; in CX, and arranges for it to be NUL-terminated.
getstring;
		call skipspace
		jc .eol
		lea cx,[si-1]		; point CX at the start
		mov bx,si		; remember char after last nonspace

.scan:		call getchar
		jc .terminate		; end of line => done
		jz .scan		; whitespace => keep looking
		mov bx,si		; remember char after last nonspace
		jmp .scan		; and keep looking

.terminate:
		; AL contains terminating character
		; BX points at terminating character
		; CX points at start
		cmp al,0x0a
		je .crlf
		cmp al,0x0d
		je .crlf
		cmp al,'#'
		jne .done

		; we found a hash, which requires special handling
		inc si			; skip the hash
		call getchar		; read what's after it
		jc .done		; if EOL (or EOF), we're golden
		dec si			; else, point back at it
		mov byte [si], '#'	; make it a hash to simulate EOL
		jmp .done

.crlf:		
		inc si			; point at the next line
		mov word [FoundEOL],1	; remember that for later
.done:
		mov byte [bx],0		; NUL terminate
		sub bx,cx		; compute count
		xchg bx,cx		; proper return order
		clc
.eol:		ret


; Each command definition should first call the Command macro to arrange
; for the command to be added to the command table and emit a preamble.
; This is followed immediately by the code required to implement the
; command.
;
; On entry, SI will point at the next usable character on the line
; containing the command; it should be updated to reflect any characters
; processed, but should otherwise be preserved.
; 
; The carry and direction flags are clear on entry and must be clear on
; return, except that carry should be set on return if there was an error
; that should cause processing to terminate.


; ****************************************************************************
;; *** CONTROL COMMANDS
;;
;; Several commands are available to control the flow of processing:
;;

; ****************************************************************************
;; - NOP
;;   Does nothing.
;;
Command 'nop'
		ret

; ****************************************************************************
;; - BLOCK [label]
;;   Starts a new main block, and possibly defines a label which may
;;   be referred to by the SKIP command.  This command has no effect
;;   if enountered in the normal command sequence.
;;
Command 'block'
		ret

; ****************************************************************************
;; - LABEL <label>
;;   Defines a label which may be referred to by the SKIP command.
;;   This command has no effect if encountered in the normal command
;;   sequence
;;
Command 'label'
		ret

; ****************************************************************************
;; - SKIP <label>
;;   Skip forward to the next occurrance of a BLOCK or LABEL command
;;   with the specified label.  If none is found before the end of
;;   the configuration file, processing terminates.  Note that there
;;   is no mechanism for branching backward.
;;
Command 'skip'
		call getword
		jc .done
		SHOWW cx
		SHOWSTR bx
		cmp cx,SkipLabel_len
		ja .fail
		xchg si,bx		; save the config pointer
		mov di,SkipLabel
		mov [SkipLen],cx
		rep movsb		; copy the label
		mov si,bx		; restore the config pointer
		mov byte [SkipMode],4
		clc
.done:		ret
.fail:		stc
		ret

; ****************************************************************************
;; - NEXT
;;   Skip forward to the next BLOCK command.  If none is found before
;;   the end of the configuration file, processing terminates.
;;
Command 'next'
		mov byte [SkipMode],3
		ret

; ****************************************************************************
;; - STOP
;;   Terminate processing immediately, and return to syslinux without
;;   taking any further action.
;;
fail:		call print_str
		jmp short exit
Command 'stop'
exit:
		MARK 'Exit'
%ifdef DEBUG
		mov si,CRLF
		call print_str
%endif
		int 0x20

; ****************************************************************************
;; *** ACTIONS
;;
;; A number of commands are available which perform various actions such
;; as producing output or asking SYSLINUX to run a program.
;;

; ****************************************************************************
;; - SET <mask>
;;   Sets the specified bits in the global flag word.
;;
Command 'set'
		call getnumber
		jc .done
		SHOWD eax
		SHOWD dword [UserFlags]
		or [UserFlags],eax
		SHOWD dword [UserFlags]
.done:		ret

; ****************************************************************************
;; - CLEAR <mask>
;;   Clears the specified bits in the global flag word.
;;
Command 'clear'
		call getnumber
		jc .done
		SHOWD eax
		SHOWD dword [UserFlags]
		not eax
		and [UserFlags],eax
		SHOWD dword [UserFlags]
.done:		ret

; ****************************************************************************
;; - SAY <message>
;;   Print the specified message on the console.
;;
Command 'say'
		call getstring
		jc .done
		SHOWW cx
		SHOWSTR bx
		push si
		mov si,bx
		call print_str
		mov si,CRLF
		call print_str
		pop si
		clc
.done:		ret

; ****************************************************************************
;; - PEEKB <addr> <message>
;; Print <message> followed by a one-byte value from <addr> in hex.
;;
Command 'peekb'
		call getaddr
		jc .done
		call getstring
		jc .done2
		SHOWSTR bx
		mov cl,[es:di]
		push si
		mov si,bx
		call print_str
		mov ah,0x02
		mov dl,' '
		int 0x21
		mov al,cl
		call print_byte
		mov si,CRLF
		call print_str
		clc
		pop si
.done2:		push ds
		pop es
.done:		ret

; ****************************************************************************
;; - PEEKW <addr> <message>
;; Print <message> followed by a two-byte value from <addr> in hex.
;;
Command 'peekw'
		call getaddr
		jc .done
		call getstring
		jc .done2
		SHOWSTR bx
		mov cx,[es:di]
		push si
		mov si,bx
		call print_str
		mov ah,0x02
		mov dl,' '
		int 0x21
		mov ax,cx
		call print_word
		mov si,CRLF
		call print_str
		clc
		pop si
.done2:		push ds
		pop es
.done:		ret

; ****************************************************************************
;; - PEEKD <addr> <message>
;; Print <message> followed by a four-byte value from <addr> in hex.
;;
Command 'peekd'
		call getaddr
		jc .done
		call getstring
		jc .done2
		SHOWSTR bx
		mov ecx,[es:di]
		push si
		mov si,bx
		call print_str
		mov ah,0x02
		mov dl,' '
		int 0x21
		mov eax,ecx
		call print_dword
		mov si,CRLF
		call print_str
		clc
		pop si
.done2:		push ds
		pop es
.done:		ret

; ****************************************************************************
;; - PEEKS <addr> <count> <message>
;; Print <message> followed by a string which starts at <addr> and
;; continues for <count> bytes or until a NUL, whichever comes first.
;;
Command 'peeks'
		call getaddr
		jc .done
		call getnumber
		jc .done2
		SHOWW ax
		mov dx,ax
		call getstring
		jc .done2
		SHOWSTR bx
		mov cx,dx
		push si
		mov si,bx
		call print_str
		mov ah,0x02
		mov dl,' '
		int 0x21
		mov si,di

		jcxz .strend
.next:		es lodsb
		cmp al,0
		jz .strend
		mov dl,al
		int 0x21
		loop .next

.strend:
		mov si,CRLF
		call print_str
		clc
		pop si
.done2:		push ds
		pop es
.done:		ret


; ****************************************************************************
;; - POKE <addr> <value>
;; Write the 8-bit byte <value> to memory location <addr>.
;; This command is _very dangerous_ and is present only in DEBUG builds.
;;
%ifdef DEBUG
Command 'poke'
		call getaddr
		jc .done
		call getnumber
		jc .done2
		SHOWB al
		mov [es:di],al
.done2:		push ds
		pop es
.done:		ret
%endif

; ****************************************************************************
;; - RUN <cmdline>
;;   Ask SYSLINUX to run the specified command as if it had been typed
;;   by the user.  If the command returns, processing continues with
;;   the next command.
;;
Command 'run'
		call getstring
		jc .done
		SHOWSTR bx
		mov ax,0x0003
		RUN
.done:		ret

; ****************************************************************************
;; - KERNEL <kernel> <args>
;;   Ask SYSLINUX to load the specified kernel with the given arguments,
;;   as if they had been given using the KERNEL and APPEND commands.
;;
Command 'kernel'
		call getword
		jc .done
		SHOWSTR bx
		mov di,bx		; save the kernel name
		call getstring
		jnc .gotargs
		mov bx,EmptyStr		; use empty string if no args
.gotargs:	SHOWSTR 'Append',bx
		xchg si,di		; keep the string pointer for later
		mov ax,0x0016		; run kernel image
		xor ecx,ecx		; no IPAPPEND
		mov edx,ecx		; determine type automatically
		RUN
		mov si,di		; restore the string pointer
.done:		ret

; ****************************************************************************
;; - CONFIG <cfgfile>
;;   Ask SYSLINUX to restart using the specified config file.
;;
Command 'config'
		call getstring
		jc .done
		SHOWSTR bx
		mov ax,0x0016		; run kernel image
		mov si,bx		; config file is the "kernel"
		mov bx,EmptyStr		; no arguments
		xor ecx,ecx		; no IPAPPEND
		mov edx,8		; syslinux config file
		RUN
.done:		ret


; ****************************************************************************
;; *** CONDITIONALS
;;
;; A variety of conditionals commands are available, each of which performs
;; some sort of test.  If the test is successful, processing continues
;; normally when the next command.  If the test fails, then any following
;; commands are ignored until the next ELSE, ENDC, or BLOCK command, at
;; which processing resumes normally.  If no such command is found before
;; the end of the configuration file, then processing terminates.
;;
;; Note that the command processor is fairly simplistic, and conditionals
;; CANNOT be nested as in other languages.  However, it is possible for
;; several conditionals in sequence to share the same ELSE or ENDC, such
;; that all of the tests must be satisfied in order for any following
;; actions to be executed.
;;

;; A number of conditionals include a <cmp> argument which describes
;; how to compare two numbers (generally, one unknown value and one
;; value specified after the operator).  Such an operator may be built
;; from any meaningful combination of '<', '=', and '>', with the
;; obvious meanings.  Duplication is permitted, as in '==', '===', or
;; even '<==<=', but a combination such as '<=>' is not permitted,
;; because it would always be true.
;;
;; The operator '!=' is an alias for '<>'.
;;
;; The operator '&' indicates a comparison which is true if the result
;; of a bitwise AND of the two operands is nonzero.  This can be used
;; to test specific bits in a value.
;;
;; Operators may be separated from the following number by a space,
;; but this is not required.  In addition, the operator may be left
;; out entirely, which has the same effect as '='.
;;

; Read from the config buffer an optional comparison specifier (one of
; < > = <= >= <>) followed by a numeric argument in decimal or hex, and
; return the argument in ECX and a code representing the desired
; comparison in BX.  If present, the comparison specifier may be separated
; from the numeric argument by whitespace, but is not required to be.  If
; the next word(s) do not represent a valid comparison and number, the
; carry flag is set.  In addition, EAX is set to zero in preparation for
; loading a less-than-DWORD sized value for comparison.
; DX and arithmetic flags are destroyed; all other registers are preserved.
;
; The following codes are used to represent comparisons:
; 0 none given (default is '=')
; 1 <
; 2 =
; 3 <=
; 4 >
; 5 <> or !=
; 6 >=
; 7 reserved, in case '<=>' slips through
; 8 &
getcompare:
		xor eax,eax		; keep eax==al
		call skipspace
		jc .eol

		; look for special operators
		mov bx,8		; See if we have the '&' operator
		cmp al,'&'
		je .gotop
		cmp al,'!'		; Try !=
		je .tryne

		mov bx,0		; start with no bits set
.scan:		cmp al,'>'
		ja .gotprefix
		cmp al,'<'
		jb .gotprefix
		sub al,'<'
		bts bx,ax
		cmp bx,7
		je .bogus
		call getchar
		jc .eol
		jnz .scan

.gotop:		; we've seen the whole operator and maybe some whitespace
		; so what comes next must be the number (or whitespace)
		call getnumber
		jc .eol

.gotitall:	; we've parsed an operator and a reference value
		; time to clean up and return
		mov ecx,eax
%ifdef DEBUG
		mov dl,[compare_chrs+bx]
		mov ah,0x02
		int 0x21
%endif
		SHOWD ecx
		xor eax,eax
		clc
.eol:		ret

.tryne:		; we've seen a '!', which is either the start of '!='
		; or else something completely invalid.
		call getchar		; get the next char
		jc .eol
		cmp al,'='
		jne .eol		; anything other than = is invalid
		mov bx,5		; same as <>
		jmp .gotop

.gotprefix:	; we've seen a prefix operator plus some other character,
		; which we need to pass on to getnumber.
		call getnumber.special
		jnc .gotitall
	
.bogus:		stc
		ret


; Process a numeric comparison, as parsed by getcompare, above.
; This compares the values in EAX and ECX according to the mode
; specified in BX.  If the result is false, skipmode is set to 1;
; else it is set to 0.
compare:
		cmp bx,(.endops-.ops)/8
		jae .ops	; unknown code = use default
		shl bx,3
		add bx,.ops
		cmp eax,ecx
		jmp bx

; entries in this table must be exactly 8 bytes long
.ops:
%macro CompareOp 1
		set%-1 byte [word SkipMode]	; 5 bytes
		nop				; 1 byte
		jmp short .done			; 2 bytes
%endmacro
		CompareOp e  ; 0 - default (=)
		CompareOp b  ; 1 - <
		CompareOp e  ; 2 - =
		CompareOp be ; 3 - <=
		CompareOp a  ; 4 - >
		CompareOp ne ; 5 - <> !=
		CompareOp ae ; 6 - >=
		; 7 error
		FAIL 'invalid comparison';	; 6 bytes
		nop
		nop
		; 8 - &
		test eax,ecx			; 3 bytes
		setnz al			; 3 bytes
		jmp short .doneax		; 2 bytes
.endops:

.doneax:
		mov [SkipMode],al
.done:
%ifdef DEBUG
		mov dl,0x01			; smiley
		test byte [SkipMode],1
		je .true
		add dl,0x12			; !!
.true:		mov ah,0x02
		int 0x21
%endif
		push ds
		pop es
		clc
		ret

; ****************************************************************************
;; - TEST <mask> [<value>]
;;   A condition which tests the global flag word.  If both mask and
;;   value are specified, the flag word is first masked and then
;;   checked to see if the result is equal to the given value; if so,
;;   the condition is true.  If only a mask is given, then the
;;   condition is true if all of the bits in the mask are set.
;;
Command 'test',1
		call getnumber
		jc .done
		mov ecx,eax
		SHOWD ecx
		call getnumber
		jnc .gotval
		mov eax,ecx
.gotval:	SHOWD eax
		SHOWD [UserFlags]
		and ecx,[UserFlags]		; check (mask & flags)
		cmp ecx,eax			; == value ?
		setne byte [SkipMode]		; if not, start skipping
		jmp compare.done
.done:		ret


; ****************************************************************************
;; - BYTE <addr> <cmp> <value>
;;   A condition, true or false according to the specified comparison
;;   between the byte at the specified address and the indicated value.
;;    
Command 'byte',1
		call getaddr
		jc .done
		call getcompare
		jc .done
		mov al,[es:di]
		SHOWB al
		jmp compare
.done:		ret

; ****************************************************************************
;; - WORD <addr> <cmp> <value>
;;   A condition, true or false according to the specified comparison
;;   between the word at the specified address and the indicated value.
;;    
Command 'word',1
		call getaddr
		jc .done
		call getcompare
		jc .done
		mov ax,[es:di]
		SHOWW ax
		jmp compare
.done:		ret

; ****************************************************************************
;; - DWORD <addr> <cmp> <value>
;;   A condition, true or false according to the specified comparison
;;   between the double word at the specified address and the indicated
;;   value.
;;    
Command 'dword',1
		call getaddr
		jc .done
		call getcompare
		jc .done
		mov eax,[es:di]
		SHOWD eax
		jmp compare
.done:		ret

; ****************************************************************************
;; - STRING <addr> <string>
;;   A condition, true if the indicated string is present in memory at
;;   the given address.
;;
Command 'string',1
		call getaddr
		jc .done
		call getstring
		jc .done2
		SHOWSTR bx
		xchg si,bx		; save config pointer in bx
		repz cmpsb		; do the string compare
		mov si,bx		; restore config pointer
		setne byte [SkipMode]	; if not equal, start skipping
		jmp compare.done
.done2:		push ds
		pop es
.done:		ret

; ****************************************************************************
;; - VERSION <cmp> <value>
;;   A condition, true or false according to the specified comparison
;;   between the 32-bit bioschk version code and the indicated value.
;;    
Command 'version',1
		call getcompare
		jc .done
		mov eax,Version
		SHOWD eax
		jmp compare
.done:		ret

; ****************************************************************************
;; - ASK <timeout> <prompt>
;;   A condition, which is evaluated by prompting the user with the
;;   specified prompt.  The condition is true if the user answers
;;   "yes", and false if he answers "no", or if no answer is given
;;   within <timeout> seconds.
;;

%macro WhatTimeIsIt 1
  int 0x1a		; get the time in CX:DX
  shl ecx,16
  mov cx,dx
%if %1
  test al,al
  jz %%today
  add ecx,0x1800B0	; clock ticks per day
%%today
%endif
%endmacro

Command 'ask'
		call getnumber
		jc .done2
		mov edx,182	; 18.2 clocks per second
		mov ecx,10
		mul edx
		div ecx
		mov ebp,eax
		SHOWD ebp
		call getstring
.done2:		jc .done
		SHOWSTR bx
		push si
		mov di,bx

.prompt:	
		mov si,di
		call print_str
		mov si,YESNO
		call print_str
		WhatTimeIsIt 0
		lea ebx,[ecx+ebp]

.wait:
		mov ax,0x13		; syslinux idle call
		int 0x22
		mov ah,0x0b		; check keyboard
		int 0x21
		test al,al
		jnz .ready

		; check the time
		WhatTimeIsIt 1
		cmp ebx,ecx
		jb .wait

		mov si,msg_timeout
		call print_str
		pop si
		mov byte [SkipMode],1	; timeout => false
		clc
.done:		ret

.ready:
		mov ah,0x08		; get key no echo
		int 0x21
		and al,al
		jne .gotkey
		mov ah,0x08		; get key no echo
		int 0x21
		jmp .prompt		; function key never useful

.gotkey:
		cmp al,0x1b		; ESC = quit
		je exit
		mov ah,al
		or ah,0x20		; downcase
		cmp ah,'y'
		je .answer
		cmp ah,'n'
		je .answer
		mov si,CRLF
		call print_str
		jmp .prompt

.answer:	test ah,1		; n is even; y is odd!
		setz byte [SkipMode]	; no means start skipping
		mov ah,0x02
		mov dl,al
		int 0x21
		mov si,CRLF
		call print_str
		pop si
		clc
		ret

; ****************************************************************************
;; - ELSE [subcommand]
;;   This command is used to mark the start of the "false" branch of a
;;   conditional.  It comes in two forms, with and without an optional
;;   subcommand.
;;   
;;   During normal processing, the ELSE command without a subcommand
;;   causes any following commands to be ignored until the next ENDC or
;;   BLOCK command.  If no such command is found before the end of the
;;   configuration file, then processing terminates.  The effect is that
;;   ELSE without a subcommand introduces a "false" branch ending at the
;;   next ENDC or BLOCK command, or at the end of the configuration file.
;;
;;   When the ELSE command is used with a subcommand, the subcommand will
;;   be executed only when the ELSE is found as a result of the search
;;   performed when a conditional test fails.  If the ELSE is encountered
;;   during normal command processing, the subcommand is ignored.  Also,
;;   if the ignored subcommand is a conditional, then any following
;;   commands are also ignored, until the next ENDC or BLOCK command or
;;   the end of the configuration file.  The effect of this is that the
;;   ELSE command may be used with a conditional in a sort of "else if"
;;   construct forming a multi-way branch, or with some other command
;;   as a shorthand for a three-line construct consisting of ELSE, the
;;   subcommand, and ENDC.
;;
;;   Note that due to the way control processing works, "ELSE ENDC" and
;;   "ELSE NOP" are both equivalent to just "ENDC", and "ELSE LABEL" and
;;   "ELSE BLOCK" do not work at all.
;;
Command 'else'
		call skipspace
		jc .nosubcmd
		mov byte [SkipMode],0x80 ; let the subcommand decide
		ret
.nosubcmd:	mov byte [SkipMode],2	 ; skip to ENDC or BLOCK
		clc
		ret

; ****************************************************************************
;; - ENDC
;;   This command is used to mark the end of a sequence of statements
;;   introduced by a conditional or ELSE command.  It has no effect when
;;   encountered in normal processing.
;;
Command 'endc'
		ret

; ****************************************************************************
;; *** COMMAND ARGUMENTS
;;
;; Labels given as arguments to the LABEL, BLOCK, and SKIP commands are
;; limited to up to 32 printable characters.
;;
;; Address arguments are taken as 20-bit real-mode physical addresses, and
;; may be given in decimal or in hexadecimal with an '0x' or '$' prefix.
;;
;; Numeric arguments, such as the masks and values given to the various
;; conditionals and to the SET and CLEAR commands, may also be given in
;; decimal or in hexadecimal with an '0x' or '$' prefix.  When given in
;; decimal, these arguments are treated as signed, but currently only
;; positive values may be given.  This means that a value with bit 31
;; set can be given only in hex.
;;
;; A string argument always begins with the next non-whitespace character.
;; When a string argument is not the last argument shown, it ends at the
;; next whitespace.  Otherwise, it continues to the end of the line, but
;; does not include trailing whitespace.


; ****************************************************************************
;;
;; *** EXAMPLE CONFIGURATION
;;
;; The following example demonstrates many of the available commands.
;;
;; # Test Dell Optiplex GX620 BIOS version A11, which is known to cause
;; # some problems.  If it is found, offer to upgrade the BIOS.
;; STRING 0xfe076 Dell System   # Is it a Dell?
;; ELSE SKIP not_dell           # If not, move along
;;
;; BLOCK gx620
;;   WORD   0xfe840 =0x01ad       # System ID for GX620
;;   BYTE   0xfe845 =0xfe         # System ID is valid if this is present
;;     SAY  Looks like this is a Dell Optiplex GX620.
;;   ELSE NEXT
;;   # Now check the BIOS version
;;   STRING 0xfe842 A11
;;     SAY  Optiplex GX620 BIOS version A11 is known to cause problems
;;     SAY  for the network install menu and for some Linux configurations.
;;     SAY  Downgrading to version A10 is recommended.
;;     SET  1  # This flag means it is not safe to run the menu
;;   ELSE STRING 0xfe842 A10
;;     NEXT
;;   ELSE
;;     SAY  This machine is running an older BIOS version.
;;     SAY  Upgrading to version A10 is recommended.
;;   ENDC
;;   SAY    Answer 'YES' to run the Optiplex GX620 BIOS version A10 installer.
;;   ASK 30 Run the BIOS installer?
;;     RUN  bios_gx620_a10
;;
;; BLOCK # just to mark the end of the last Dell block
;;
;; LABEL not_dell
;;
;; # If no problems were found that would break the menu, go ahead
;; # and start it.  OTherwise, switch to a config that allows the user
;; # to type a command indicating what he wants to do.
;; BLOCK default
;;   TEST 1
;;     CONFIG nomenu.cfg
;;   ELSE
;;     KERNEL menu.c32


; ****************************************************************************
; Output Routines
; ****************************************************************************

; Take a NUL-terminated string in SI and write it to stdout.
; Destroys AX and DX
print_str:
		mov ah,0x02
.next		lodsb
		test al,al
		jz .done
		mov dl,al
		int 0x21
		jmp .next
.done:		ret

; print a 32-bit number in eax; destroys eax,bx,dx
print_dword:	push eax
		shr eax,16
		call print_word
		pop eax
		; fall through

; print a 16-bit number in ax; destroys ax,bx,dx
print_word:	push ax
		mov al,ah
		call print_byte
		pop ax
		; fall through

; print an 8-bit hex number in al; destroys ax,bx,dx
print_byte:	mov bx,hex_table
		aam 16
		xlat
		xchg ah,al
		xlat
		mov dx,ax
		mov ah,0x02
		int 0x21
		mov dl,dh
		int 0x21
		ret


; ****************************************************************************
; Global Data
; ****************************************************************************
		section .strings follows=.text align=1
hex_table	db '0123456789abcdef'
msg_timeout	db 'Timed out',0x0d,0x0a,0
YESNO		db ' (Y/N)? ',0

%ifdef DEBUG
compare_chrs	db '?', '<', '=', 0xf3, '>', '!', 0xf2
msg_skip	db 'SKIP:',0
msg_unknown	db '???',0
EndCRLF		db 0xb0
%endif
CRLF		db 0x0d,0x0a
EmptyStr	db 0

		section .cmdtable follows=.strings
CommandTable	equ $$
NumCommands	equ ($-$$) / 8

		section .data
UserFlags	dd 0
FoundEOL	dw 1		; do the right thing at startup
SkipLen		dw 0
SkipMode	db 0

SkipLabel	times 32 db 0
SkipLabel_len	equ $-SkipLabel

		section .bss align=512
		alignb 512
ConfigBuf:	; all of the rest of available memory!


More information about the Syslinux mailing list