dono@killer.DALLAS.TX.US (Don OConnell) (01/13/89)
I personally use Turboc 1.5 and Masm 4 & 5 for doing all my Minix work.
I don't know what assembler hannam is using (I think that is one that he
wrote). The syntax seems to be half-way between masm and minix asld. I didn't
have too much trouble porting it to masm syntax.
Since I mentioned using the tty driver in posting I have received several
pieces of mail asking for a minix version of klib88(I should have specified
what I used in the prev. posting), and I have seen some messages in the past
asking for minix ports. So I sat down and converted klib88.as -> klib88.s,
it only took a couple of hours. Since I don't use minix as my development
system, I can't test it and see if it works(I am trying to say that I think
I did the port correctly but no guarantees). I would like it if some person
more competent person(assembler wise) would check it out and make sure I
didn't royally screw it up. I marked most places that I wasn't sure about
with my initials "dro".
----------------------- Any way here it is -----------------------------------
|THIS TRANSLATION IS BY DON O'CONNELL [killer!dono] AND I WON'T SWEAR IT
|IS A 100% GOOD BUT IT SHOULD BE CLOSE
|Most of the things that I changed or added are marked as such look for "dro"
|About half of the routines came directly from the klib88.s(13c) file.
| I think that this is all that is needed - Don O'Connell 01-13-88 00:30:00
| This file is significantly different in code to klib88.s. It does however
| perform the same functions in the same way as the original klib88.
| i.e. It is largly a translation with a few optimizations. Throughout the
| file the word 'INT' in the comment means to comment out the entire line to
| improve interrupt latency. The 'INT' will be followed by a class letter.
| E.g. INTV indicates all video routine interrupts.
| This file contains a number of assembly code utility routines needed by the
| kernel. They are:
| phys_copy: copies data from anywhere to anywhere in memory
| cp_mess: copies messages from source to destination
| dma_read: transfer data between HD controller and memory
| dma_write: transfer data between memory and HD controller
| lock: disable interrupts
| restore: restore interrupts (enable/disabled) as they were before lock()
| build_sig: build 4 word structure pushed onto stack for signals
| csv: procedure prolog to save the registers
| cret: procedure epilog to restore the registers
| get_chrome: returns 0 if display is monochrome, 1 if it is color
| vid_write: write data to video ram (on color display during retrace only)
| vid_fill: fill a section of video ram with a char (and attribute)
| vid_fmove: move a section of video ram around (using forward copies)
| vid_bmove: move a section of video ram around (using backward copies)
| get_byte: reads a byte from a user program and returns it as value
| put_byte: writes a byte to a user program
| reboot: reboot for CTRL-ALT-DEL
| wreboot: wait for character then reboot
| em_xfer: read or write AT extended memory using the BIOS
| The following procedures are defined in this file and called from outside it.
.globl _phys_copy, _cp_mess, _lock, _restore, _em_xfer
.globl _build_sig, _get_chrome, _vid_write, _vid_fill, _vid_fmove, _vid_bmove
.globl _get_byte, _put_byte, _reboot, _wreboot, _dma_read, _dma_write
| The following external procedure is called in this file.
.globl _panic
| Variables and data structures
.globl _cur_proc, _proc_ptr, _vec_table, _port_65, _ps
.globl _color, _vid_mask, _vid_retrace, _vid_base
|*===========================================================================*
|* phys_copy *
|*===========================================================================*
| This routine copies a block of physical memory. It is called by:
| phys_copy( (long) source, (long) destination, (long) bytecount)
| THIS IS STRAIGHT FROM THE 13C KLIB88.S FILE - dro
_phys_copy:
pushf | save flags
| cli | disable interrupts
cld | clear direction flag
push bp | save the registers
push ax | save ax
push bx | save bx
push cx | save cx
push dx | save dx
push si | save si
push di | save di
push ds | save ds
push es | save es
mov bp,sp | set bp to point to saved es
L0: mov ax,28(bp) | ax = high-order word of 32-bit destination
mov di,26(bp) | di = low-order word of 32-bit destination
mov cx,*4 | start extracting click number from dest
L1: rcr ax,*1 | click number is destination address / 16
rcr di,*1 | it is used in segment register for copy
loop L1 | 4 bits of high-order word are used
mov es,di | es = destination click
mov ax,24(bp) | ax = high-order word of 32-bit source
mov si,22(bp) | si = low-order word of 32-bit source
mov cx,*4 | start extracting click number from source
L2: rcr ax,*1 | click number is source address / 16
rcr si,*1 | it is used in segment register for copy
loop L2 | 4 bits of high-order word are used
mov ds,si | ds = source click
mov di,26(bp) | di = low-order word of dest address
and di,*0x000F | di = offset from paragraph # in es
mov si,22(bp) | si = low-order word of source address
and si,*0x000F | si = offset from paragraph # in ds
mov dx,32(bp) | dx = high-order word of byte count
mov cx,30(bp) | cx = low-order word of byte count
test cx,#0x8000 | if bytes >= 32768, only do 32768
jnz L3 | per iteration
test dx,#0xFFFF | check high-order 17 bits to see if bytes
jnz L3 | if bytes >= 32768 then go to L3
jmp L4 | if bytes < 32768 then go to L4
L3: mov cx,#0x8000 | 0x8000 is unsigned 32768
L4: mov ax,cx | save actual count used in ax; needed later
test cx,*0x0001 | should we copy a byte or a word at a time?
jz L5 | jump if even
rep | copy 1 byte at a time
movb | byte copy
jmp L6 | check for more bytes
L5: shr cx,*1 | word copy
rep | copy 1 word at a time
movw | word copy
L6: mov dx,32(bp) | decr count, incr src & dst, iterate if needed
mov cx,30(bp) | dx || cx is 32-bit byte count
xor bx,bx | bx || ax is 32-bit actual count used
sub cx,ax | compute bytes - actual count
sbb dx,bx | dx || cx is # bytes not yet processed
or cx,cx | see if it is 0
jnz L7 | if more bytes then go to L7
or dx,dx | keep testing
jnz L7 | if loop done, fall through
pop es | restore all the saved registers
pop ds | restore ds
pop di | restore di
pop si | restore si
pop dx | restore dx
pop cx | restore cx
pop bx | restore bx
pop ax | restore ax
pop bp | restore bp
popf | restore flags
ret | return to caller
L7: mov 32(bp),dx | store decremented byte count back in mem
mov 30(bp),cx | as a long
add 26(bp),ax | increment destination
adc 28(bp),bx | carry from low-order word
add 22(bp),ax | increment source
adc 24(bp),bx | carry from low-order word
jmp L0 | start next iteration
|*===========================================================================*
|* cp_mess *
|*===========================================================================*
| This routine is makes a fast copy of a message from anywhere in the address
| This routine makes a fast copy of a message from anywhere in the address
| space to anywhere else. It also copies the source address provided as a
| parameter to the call into the first word of the destination message.
| It is called by:
| cp_mess(src, src_clicks, src_offset, dst_clicks, dst_offset)
| where all 5 parameters are shorts (16-bits).
|
| Note that the message size, 'Msize' is in WORDS (not bytes) and must be set
| correctly. Changing the definition of message in type file and not changing
| it here will lead to total disaster.
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
Msize = 12 | size of a message in 16-bit words
_cp_mess:
push es | save es
push ds | save ds
mov bx,sp | index off bx because machine can't use sp
pushf | save flags
cli | disable interrupts
push si | save si
push di | save di
mov di,14(bx) | di = offset of destination buffer
les si,10(bx) | use 32 bit load(ds is our base)
| si = offset of source message
| es = clicks of destination
lds ax,6(bx) | use 32 bit load ....
| ax = process number of sender
| ds = clicks of source message
seg es | segment override prefix
mov (di),ax | copy sender's process number to dest message
add si,*2 | don't copy first word
add di,*2 | don't copy first word
mov cx,*Msize-1 | remember, first word doesn't count
cld | clear direction flag
rep | iterate cx times to copy 11 words
movw | copy the message
pop di | restore di
pop si | restore si
popf | restore flags (resets interrupts to old state)
pop ds | restore ds
pop es | restore es
ret | that's all folks!
|*===========================================================================*
|* dma_read *
|*===========================================================================*
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_dma_read:
push bp
mov bp,sp
push cx
push dx
push di
push es
mov cx,#256 | transfer 256 words
mov dx,#0x1F0 | from/to port 1f0
cld
mov es,4(bp) | segment in es
mov di,6(bp) | offset in di
.byte 0xF3, 0x6D | opcode for 'rep insw'
pop es
pop di
pop dx
pop cx
mov sp,bp
pop bp
ret
|*===========================================================================*
|* dma_write *
|*===========================================================================*
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_dma_write:
push bp
mov bp,sp
push cx
push dx
push si
push ds
mov cx,#256 | transfer 256 words
mov dx,#0x1F0 | from/to port 1f0
cld
mov ds,4(bp) | segment in ds
mov si,6(bp) | offset in si
.byte 0xF3, 0x6F | opcode for 'rep outsw'
pop ds
pop si
pop dx
pop cx
mov sp,bp
pop bp
ret
|*===========================================================================*
|* lock *
|*===========================================================================*
| Disable CPU interrupts. Return old psw as function value.
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_lock:
pushf | save flags on stack
cli | disable interrupts
pop ax | return flags for restoration later
ret | return to caller
|*===========================================================================*
|* restore *
|*===========================================================================*
| restore enable/disable bit to the value it had before last lock.
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_restore:
push bp | save it
mov bp,sp | set up base for indexing
push 4(bp) | bp is the psw to be restored
popf | restore flags
pop bp | restore bp
ret | return to caller
|*===========================================================================*
|* build_sig *
|*===========================================================================*
|* Build a structure that is pushed onto the stack for signals. It contains
|* pc, psw, etc., and is machine dependent. The format is the same as generated
|* by hardware interrupts, except that after the "interrupt", the signal number
|* is also pushed. The signal processing routine within the user space first
|* pops the signal number, to see which function to call. Then it calls the
|* function. Finally, when the function returns to the low-level signal
|* handling routine, control is passed back to where it was prior to the signal
|* by executing a return-from-interrupt instruction, hence the need for using
|* the hardware generated interrupt format on the stack. The call is:
|* build_sig(sig_stuff, rp, sig)
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
| Offsets within proc table
PC = 24
csreg = 18
PSW = 28
_build_sig:
push bp | save bp
mov bp,sp | set bp to sp for accessing params
push bx | save bx
push si | save si
mov bx,4(bp) | bx points to sig_stuff
mov si,6(bp) | si points to proc table entry
mov ax,8(bp) | ax = signal number
mov (bx),ax | put signal number in sig_stuff
mov ax,PC(si) | ax = signalled process' PC
mov 2(bx),ax | put pc in sig_stuff
mov ax,csreg(si) | ax = signalled process' cs
mov 4(bx),ax | put cs in sig_stuff
mov ax,PSW(si) | ax = signalled process' PSW
mov 6(bx),ax | put psw in sig_stuff
pop si | restore si
pop bx | restore bx
pop bp | restore bp
ret | return to caller
|*===========================================================================*
|* csv & cret *
|*===========================================================================*
| This version of csv replaces the standard one. It checks for stack overflow
| within the kernel in a simpler way than is usually done. cret is standard.
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
csv:
pop bx | bx = return address
push bp | stack old frame pointer
mov bp,sp | set new frame pointer to sp
push di | save di
push si | save si
sub sp,ax | ax = # bytes of local variables
cmp sp,splimit | has kernel stack grown too large
jbe csv.1 | if sp is too low, panic
jmp (bx) | normal return: copy bx to program counter
csv.1:
mov splimit,#0 | prevent call to panic from aborting in csv
mov bx,_proc_ptr | update rp->p_splimit
mov 50(bx),#0 | rp->sp_limit = 0
push _cur_proc | task number
mov ax,#stkoverrun | stack overran the kernel stack area
push ax | push first parameter
call _panic | call is: panic(stkoverrun, cur_proc)
jmp csv.1 | this should not be necessary
cret:
lea sp,*-4(bp) | set sp to point to saved si
pop si | restore saved si
pop di | restore saved di
pop bp | restore bp
ret | end of procedure
|*===========================================================================*
|* get_chrome *
|*===========================================================================*
| This routine calls the BIOS to find out if the display is monochrome or
| color. The drivers are different, as are the video ram addresses, so we
| need to know. An EGA card is a 'color' for printer ports but may display
| in mono or color. A test on the result returns ...
| if (get_chrome()) ... - true if color or ega card (e.g. for printer
| port)
| if (get_chrome()&1) ... - true if color mode, false if mono mode
| if (get_chrome()&2) ... - true iff ega card
_get_chrome:
movb bl,*0x10 | SET UP TO CHECK IF EGA - dro
movb ah,*0x12
int 0x10 | call the BIOS to get equipment type
cmpb bl,*0x10 | if reg is unchanged, is not EGA
je notega
mov ax,#2 | ega = 2
ret | ega return
notega:
int 0x11 | call the BIOS to get equipment type
andb al,#0x30 | isolate color/mono field
cmpb al,*0x30 | 0x30 is monochrome
je getchr1 | if monochrome then go to getchr1
mov ax,#1 | color = 1
ret | color return
getchr1: xor ax,ax | mono = 0
ret
|*===========================================================================*
|* video routines (PUBLIC) *
|*===========================================================================*
| This routines handle writes to the screen. For a color display, the writing
| only takes places during the vertical retrace interval, to avoid displaying
| garbage on the screen. It will only display a maximum of vid_retrace words
| in a single refresh cycle for the same reason. The display ram overflow is
| handled carefully so that EGA cards work properly. These routines rely on
| the stack segment being equal to the data segment.
|
| The calls are:
| vid_write(buffer, dest, words)
| vid_fill(fillw, dest, words)
| vid_fmove(src, dest, words)
| vid_bmove(src, dest, words)
| where
| 'buffer' is a pointer to the (character, attribute) pairs
| 'fillw' is the word (character, attribute) for filling
| 'src' tells where within video ram to copy data from
| 'dest' tells where within video ram to copy the data
| 'words' tells how many words to copy
_vid_write: | let vidtransfer handle dest overflow
push bp | set up stack frame
mov bp,sp
push si | save the registers
push di
push bx | save bx------
push cx | save cx | I think these are needed for asld
push dx | save dx | dro
push es | save es------
mov es,_vid_base | screen seg register
call vidtransfer | do the transfer
pop es | restore registers ---
pop dx | restore dx | The same with these - dro
pop cx | restore cx |
pop bx | restore bx ----------
pop di | finished - clear stack frame
pop si
pop bp
ret
_vid_fill: | handle dest overflow explicitly
push bp | set up stack frame
mov bp,sp
push di | save the registers
push bx | save bx------
push cx | save cx | I think these are needed for asld
push dx | save dx | dro
push es | save es------
mov es,_vid_base | screen seg register
mov ax,4(bp) | get the fill char
mov di,6(bp) | get the dest
call lvidfill | do the initial fill
call vidcheck | check if overflow has occurred
jz v1f
call lvidfill | fix overflow
v1f:
pop es | restore registers ---
pop dx | restore dx | The same with these - dro
pop cx | restore cx |
pop bx | restore bx ----------
pop di | finished - clear stack frame
pop bp
ret
_vid_fmove: | handle src overflow explicitly
| let vidtransfer handle dest overflow
push bp | set up stack frame
mov bp,sp
push si | save the registers
push di
push ds
push bx | save bx------
push cx | save cx | I think these are needed for asld
push dx | save dx | dro
push es | save es------
mov ax,4(bp) | src &= vid_mask
and ax,_vid_mask
mov 4(bp),ax
add ax,8(bp) | if (src + words*2 > vid_mask)
add ax,8(bp) | we have src overflow.
cmp ax,_vid_mask
mov es,_vid_base | set up segment registers
mov ds,_vid_base
jle vm2 | if src overflow then
push 8(bp) | save the words count
mov bx,_vid_mask | count = MIN(count, ((vid_mask+1)-src)/2)
inc bx
sub bx,4(bp)
shr bx,#1
cmp bx,8(bp)
jle vm1
mov bx,8(bp)
vm1:
mov 8(bp),bx | bx and count now has count to do
call vidtransfer | do this first transfer
mov 4(bp),#0 | set up for remaining transfer
mov 6(bp),di
pop 8(bp) | restore our original count
sub 8(bp),bx | subtract the count done so far
jz vm3 | only continue if more to do
vm2:
call vidtransfer | do the transfer for no src overflow
vm3:
pop es | restore registers ---
pop dx | restore dx | The same with these - dro
pop cx | restore cx |
pop bx | restore bx ----------
pop ds | finished - clear stack frame
pop di
pop si
pop bp
ret
_vid_bmove: | handle src overflow explicitly
| let rvidtransfer handle dest overflow
push bp | set up stack frame
mov bp,sp
push si | save the registers
push di
push ds
push bx | save bx------
push cx | save cx | I think these are needed for asld
push dx | save dx | dro
push es | save es------
pushf
std | transfer in reverse direction
mov bx,4(bp) | src &= vid_mask
and bx,_vid_mask
mov 4(bp),bx
mov es,_vid_base | set up segment registers
mov ds,_vid_base
push 8(bp) | save the total count
shr bx,#1 | count = MIN(count, src/2 + 1)
inc bx
cmp bx,8(bp)
jle vbm1
mov bx,8(bp) | also save count in bx
vbm1:
mov 8(bp),bx
call vidrtransfer | do the transfer of non overflowing section
mov ax,_vid_mask | set up to do overflow of src
dec ax | convert to word address
mov 4(bp),ax | new src addr
pop 8(bp) | calculate count left
sub 8(bp),bx
jz vbm2 | if none to do don't continue
call vidrtransfer | transfer overflow
vbm2:
popf | finished - clear stack frame
pop es | restore registers ---
pop dx | restore dx | The same with these - dro
pop cx | restore cx |
pop bx | restore bx ----------
pop ds
pop di
pop si
pop bp
ret
|*===========================================================================*
|* video routines (private) *
|*===========================================================================*
| The following video support routines may be changed in thier interrupt
| handling methods. If a glitch due to an interrupt during screen writes
| is acceptable then comment out all lines with 'INTV' in thier comment.
| Doing this improves interrupt latency (e.g. for RS232 throughput). In
| practice I have never seen any glitches with the interrupts on.
vidtransfer: | transfer a block to the screen (forward dir)
| handle dest overflow
| final results returned in si, di
mov si,4(bp) | si = pointer to data to be copied
mov di,6(bp) | di = offset within video ram
call lvidcopy | write the block to the screen
call vidcheck | check for video ram (window) overflow
jz vt1
sub si,8(bp) | overflow - find buffer position
sub si,8(bp)
call lvidcopy | fix up overflow
vt1: ret
vidrtransfer: | transfer a block to the screen (reverse dir)
| handle dest overflow
| final results in stack frame
mov si,4(bp) | si = pointer to data to be copied
mov di,6(bp) | di = offset within video ram
call lvidcopy | write the block to the screen
call vidrcheck | check for video ram (window) overflow
xchg si,4(bp) | get orig src & dest , save final src dest
xchg di,6(bp)
jz vr1
and di,_vid_mask | address the overflow block
call lvidcopy | write the overflow block
vr1: ret
lvidcopy: | Transfer a block to the screen in sub-blocks
| with a maximum of vid_retrace words per sub-block.
mov cx,_vid_retrace | cx = MIN(count, vid_retrace)
cmp cx,8(bp)
jle lvc1
mov cx,8(bp)
lvc1:
jcxz lvc2 | only do transfer if cx != 0
sub 8(bp),cx | count -= cx
call vidcopy
jmp lvidcopy | get the next sub-block
lvc2:
ret
lvidfill: | Fill a block on the screen in sub-blocks
| with a maximum of vid_retrace words per sub-block.
mov cx,_vid_retrace | cx = MIN(count, vid_retrace)
cmp cx,8(bp)
jle lvf1
mov cx,8(bp)
lvf1:
jcxz lvf2 | only do transfer if cx != 0
sub 8(bp),cx | count -= cx
call vidfill
jmp lvidfill | get the next sub-block
lvf2:
ret
vidcopy: | Transfer a sub-block to the screen waiting for
| retrace if necessary.
call vidwait | wait for retrace if necessary
rep | I THINK THAT THIS IS HOW THESE ARE WRITTEN
movw | transfer the block | IN ASLD SYNTAX - dro
| push ax | INTV restore the flags
| popf | INTV
ret
vidfill: | Fill a sub-block on the screen waiting for
| retrace if necessary.
push ax | save the fill char
call vidwait | wait for retrace if necessary
| mov dx,ax | INTV save the flags
pop ax | restore the fill char
rep | SAME FOR THIS ONE - dro
stow | do the fill
| push dx | INTV restore the flags
| popf | INTV
ret
vidwait: | Wait for retrace only if necessary
test _color,*1 | mono's don't need retrace checking
jz vw2
test _color,*2 | ega's don't need retrace checking
jnz vw2
mov dx,#3DAH | port for retrace status
| pushf | INTV
vw1:
| sti | INTV ensure interrupts can have a go
| nop | INTV
| nop | INTV
| cli | INTV
in | wait for retrace on (orig. -- in al,[dx] -- dro)
testb al,*8
jz vw1
| pop ax | INTV return the flags in ax (ints off)
vw2: ret
vidcheck: | Check if the forward transfer just completed
| requires overflow fixing on dest. If so set up
| di and count. count = 0 on entry
mov dx,di | dx = final dest
sub dx,_vid_mask | see if overflowed
sub dx,#1 | must do sub as dec doesn't set flag
jle vck2 | if so x = overflow count
sub di,6(bp) | count = MIN(dx, final dest - init dest)
cmp di,dx
jle vck1
mov di,dx
vck1:
mov 8(bp),di | save the new count
sub dx,di | new dest = overflow count - new count
mov di,dx
vck2:
shr 8(bp),*1 | turn byte count to word count & test
ret | if any work done.
vidrcheck: | Check if the backward transfer just completed
| requires overflow fixing on dest. If so set up
| count. count = 0 on entry
mov dx,6(bp) | dx = final dest
sub dx,_vid_mask | see if overflowed
sub dx,#1 | must do sub as dec doesn't set flag
jle vrck2 | if so dx = overflow count
mov ax,6(bp) | count = MIN(dx, final dest - init dest)
sub ax,di
cmp ax,dx
jle vrck1
mov ax,dx
vrck1:
mov 8(bp),ax | save the new count
vrck2:
shr 8(bp),*1 | turn byte count to word count & test
ret | if any work done.
|*===========================================================================*
|* get_byte *
|*===========================================================================*
| This routine is used to fetch a byte from anywhere in memory.
| The call is:
| c = get_byte(seg, off)
| where
| 'seg' is the value to put in es
| 'off' is the offset from the es value
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_get_byte:
push bp | save bp
mov bp,sp | we need to access parameters
push es | save es
mov es,4(bp) | load es with segment value
mov bx,6(bp) | load bx with offset from segment
seg es | go get the byte
movb al,(bx) | al = byte
xorb ah,ah | ax = byte
pop es | restore es
pop bp | restore bp
ret | return to caller
|*===========================================================================*
|* put_byte *
|*===========================================================================*
| This routine is used to put a byte anywhere in memory.
| The call is:
| retval = put_byte(seg, off, val)
| where
| 'seg' is the value to put in es
| 'off' is the offset from the es value
| 'val' is value to put in memory
| 'retval' = val & 0xFF
_put_byte:
push bp | save bp
mov bp,sp | we need to access parameters
push es | save es
movb al,8(bp) | load al with value
mov es,4(bp) | load es with segment value
mov bx,6(bp) | load bx with offset from segment
seg es | go get the byte
movb (bx),al | put the byte
xorb ah,ah | ax = byte
pop es | restore es
pop bp | restore bp
ret | return to caller
|*===========================================================================*
|* reboot & wreboot *
|*===========================================================================*
| This code reboots the PC
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
_reboot:
cli | disable interrupts
mov ax,#0x20 | re-enable interrupt controller
out 0x20
call resvec | restore the vectors in low core
mov ax,#0x40
push ds
mov ds,ax
mov ax,#0x1234
mov 0x72,ax
pop ds
test _ps,#0xFFFF
jnz r.1
mov ax,#0xFFFF
mov ds,ax
mov ax,3
push ax
mov ax,1
push ax
reti
r.1:
mov ax,_port_65 | restore port 0x65
mov dx,#0x65
out
mov dx,#0x21 | restore interrupt mask port
mov ax,#0xBC
out
sti | enable interrupts
int 0x19 | for PS/2 call bios to reboot
_wreboot:
cli | disable interrupts
mov ax,#0x20 | re-enable interrupt controller
out 0x20
call _eth_stp | stop the ethernet chip
call resvec | restore the vectors in low core
xor ax,ax | wait for character before continuing
int 0x16 | get char
mov ax,#0x40
push ds
mov ds,ax
mov ax,#0x1234
mov 0x72,ax
pop ds
test _ps,#0xFFFF
jnz wr.1
mov ax,#0xFFFF
mov ds,ax
mov ax,3
push ax
mov ax,1
push ax
reti
wr.1:
mov ax,_port_65 | restore port 0x65
mov dx,#0x65
out
mov dx,#0x21 | restore interrupt mask port
mov ax,#0xBC
out
sti | enable interrupts
int 0x19 | for PS/2 call bios to reboot
| Restore the interrupt vectors in low core.
resvec: cld
mov cx,#2*71
mov si,#_vec_table
xor di,di
mov es,di
rep
movw
mov ax,tty_vec1 | Restore keyboard interrupt vector for PS/2
seg es
mov 452,ax
mov ax,tty_vec2
seg es
mov 454,ax
ret
| Some library routines use exit, so this label is needed.
| Actual calls to exit cannot occur in the kernel.
.globl _exit
_exit: sti
jmp _exit
|===========================================================================
| em_xfer
|===========================================================================
|
| This file contains one routine which transfers words between user memory
| and extended memory on an AT or clone. A BIOS call (INT 15h, Func 87h)
| is used to accomplish the transfer.
|
| This particular BIOS routine runs with interrupts off since the 80286
| must be placed in protected mode to access the memory above 1 Mbyte.
| So there should be no problems using the BIOS call.
|
| THIS IS TAKEN DIRECTLY FROM THE 13C KLIB88.S FILE - dro
.text
gdt: | Begin global descriptor table
| Dummy descriptor
.word 0 | segment length (limit)
.word 0 | bits 15-0 of physical address
.byte 0 | bits 23-16 of physical address
.byte 0 | access rights byte
.word 0 | reserved
| descriptor for GDT itself
.word 0 | segment length (limit)
.word 0 | bits 15-0 of physical address
.byte 0 | bits 23-16 of physical address
.byte 0 | access rights byte
.word 0 | reserved
src: | source descriptor
srcsz: .word 0 | segment length (limit)
srcl: .word 0 | bits 15-0 of physical address
srch: .byte 0 | bits 23-16 of physical address
.byte 0x93 | access rights byte
.word 0 | reserved
tgt: | target descriptor
tgtsz: .word 0 | segment length (limit)
tgtl: .word 0 | bits 15-0 of physical address
tgth: .byte 0 | bits 23-16 of physical address
.byte 0x93 | access rights byte
.word 0 | reserved
| BIOS CS descriptor
.word 0 | segment length (limit)
.word 0 | bits 15-0 of physical address
.byte 0 | bits 23-16 of physical address
.byte 0 | access rights byte
.word 0 | reserved
| stack segment descriptor
.word 0 | segment length (limit)
.word 0 | bits 15-0 of physical address
.byte 0 | bits 23-16 of physical address
.byte 0 | access rights byte
.word 0 | reserved
|
|
| Execute a transfer between user memory and extended memory.
|
| status = em_xfer(source, dest, count);
|
| Where:
| status => return code (0 => OK)
| source => Physical source address (32-bit)
| dest => Physical destination address (32-bit)
| count => Number of words to transfer
|
|
|
_em_xfer:
push bp | Save registers
mov bp,sp
push si
push es
push cx
|
| Pick up source and destination addresses and update descriptor tables
|
mov ax,4(bp)
seg cs
mov srcl,ax
mov ax,6(bp)
seg cs
movb srch,al
mov ax,8(bp)
seg cs
mov tgtl,ax
mov ax,10(bp)
seg cs
movb tgth,al
|
| Update descriptor table segment limits
|
mov cx,12(bp)
mov ax,cx
add ax,ax
seg cs
mov tgtsz,ax
seg cs
mov srcsz,ax
|
| Now do actual DOS call
|
push cs
pop es
seg cs
mov si,#gdt
movb ah,#0x87
pushf
int 0x15 | Do a far call to BIOS routine
|
| All done, return to caller.
|
pop cx | restore registers
pop es
pop si
mov sp,bp
pop bp
ret
.data
vidlock: .word 0 | dummy variable for use with lock prefix
splimit: .word 0 | stack limit for current task (kernel only)
tmp: .word 0 | count of bytes already copied
stkoverrun: .asciz "Kernel stack overrun, task = "
_vec_table: .zerow 284 | storage for interrupt vectors
tty_vec1: .word 0 | sorage for vector 0x71 (offset)
tty_vec2: .word 0 | sorage for vector 0x71 (segment)