worsley@ditmela.oz (Andrew Worsley) (05/18/89)
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 5 (of 10)."
# Contents: kerneldif/klib88.x.cdif
# Wrapped by sys@besplex on Sun Mar 26 06:34:10 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'kerneldif/klib88.x.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'kerneldif/klib88.x.cdif'\"
else
echo shar: Extracting \"'kerneldif/klib88.x.cdif'\" \(39670 characters\)
sed "s/^X//" >'kerneldif/klib88.x.cdif' <<'END_OF_FILE'
X*** /dev/null Thu Oct 13 22:40:42 1988
X--- kernel/klib88.x Mon Mar 13 04:49:00 1989
X**************
X*** 0
X--- 1,1317 -----
X+ | This file contains a number of assembly code utility routines needed by the
X+ | kernel. They are:
X+ |
X+ | cp_mess: copies messages from source to destination
X+ | lock: disable interrupts
X+ | restore: restore interrupts (enable/disabled) as they were before lock()
X+ | build_sig: build 4 word structure pushed onto stack for signals
X+ | csv: procedure prolog to save the registers
X+ | cret: procedure epilog to restore the registers
X+ | get_chrome: returns 0 if display is monochrome, 1 if it is color
X+ | get_ega: returns 1 if display is EGA, 0 otherwise
X+ | vid_copy: copy data to video ram (on color display during retrace only)
X+ | scr_up: scroll screen a line up (in software, by copying)
X+ | scr_down: scroll screen a line down (in software, by copying)
X+ | reboot: reboot for CTRL-ALT-DEL
X+ | wreboot: wait for character then reboot
X+ | wait_retrace: waits for retrace interval, and returns int disabled
X+ | ack_char: acknowledge character from keyboard
X+ | save_tty_vec: save tty interrupt vector 0x71 for PS/2
X+
X+ | These routines are new or totally rewritten and/or renamed compatibility
X+ | with protected mode.
X+
X+ | check_mem: check a block of memory, return the valid size
X+ | cim_at_wini: clear the AT winchester interrupt mask
X+ | cim_floppy: clear the floppy interrupt mask
X+ | cim_printer: clear the printer interrupt mask
X+ | cim_xt_wini: clear the XT winchester interrupt mask
X+ | codeseg: return the current code segment
X+ | dataseg: return the current data segment
X+ | get_extmemsize: ask the BIOS how much extended memory there is
X+ | get_memsize: ask the BIOS how much normal memory there is
X+ | get_phys_byte: read a byte from memory and return it
X+ | get_processor: return the processor type
X+ | inportb: read a byte from a port and return it
X+ | phys_copy: copy data from anywhere to anywhere in memory
X+ | porti_out: set a port-index pair, for hardware like 6845's
X+ | port_read: transfer data from (hard disk controller) port to memory
X+ | port_write: transfer data from memory to (hard disk controller) port
X+ | sim_printer: set the printer interrupt mask
X+ | tasim_printer: test and set the printer interrupt mask
X+ | test_and_set: test and set locking primitive on a word in memory
X+ | unlock: enable interrupts
X+
X+ | Phys_copy was rewritten because the old one was contorted and slow to start.
X+ | Get_phys_byte replaces get_byte, with a new interface.
X+ | Inportb is in addition to port_in, with a new interface.
X+ | Port_read/write replace dma_read/write, with a new interface.
X+
X+ #include "../h/const.h"
X+ #include "const.h"
X+ #include "sconst.h"
X+ #define KLIB88 .define
X+ #include "sglo.h"
X+
X+ .text
X+ |*===========================================================================*
X+ |* cp_mess *
X+ |*===========================================================================*
X+ | This routine makes a fast copy of a message from anywhere in the address
X+ | space to anywhere else. It also copies the source address provided as a
X+ | parameter to the call into the first word of the destination message.
X+ | It is called by:
X+ | cp_mess(src, src_clicks, src_offset, dst_clicks, dst_offset)
X+ | where all 5 parameters are shorts (16-bits).
X+ |
X+ | Note that the message size, 'Msize' is in WORDS (not bytes) and must be set
X+ | correctly. Changing the definition of message in the type file and not
X+ | changing it here will lead to total disaster.
X+ | This routine only preserves the registers the 'C' compiler
X+ | expects to be preserved (es, ds, si, di, sp, bp).
X+
X+ _cp_mess:
X+ push es | save es
X+ push ds | save ds
X+ mov bx,sp | index off bx because machine can't use sp
X+ push si | save si
X+ push di | save di
X+
X+ mov ax,12(bx) | destination click
X+ #if HCLICK_SHIFT > CLICK_SHIFT
X+ #error /* Small click sizes are not supported (right shift will lose bits). */
X+ #endif
X+ #if HCLICK_SHIFT < CLICK_SHIFT
X+ movb cl,#CLICK_SHIFT-HCLICK_SHIFT
X+ shl ax,cl | destination segment
X+ #endif
X+ mov es,ax
X+ mov di,14(bx) | offset of destination message
X+
X+ | Be careful not to destroy ds before we're finished with the bx pointer.
X+ | We're using bx and not the more natural bp to save pushing bp.
X+
X+ mov ax,6(bx) | process number of sender
X+ mov si,10(bx) | offset of source message
X+ mov bx,8(bx) | source click (finished with bx as a pointer)
X+ #if HCLICK_SHIFT < CLICK_SHIFT
X+ shl bx,cl | source segment
X+ #endif
X+ mov ds,bx
X+
X+ stow | copy sender's process number to dest message
X+ add si,*2 | don't copy first word
X+ mov cx,*Msize-1 | remember, first word doesn't count
X+ rep | iterate cx times to copy 11 words
X+ movw | copy the message
X+ pop di | restore di
X+ pop si | restore si
X+ pop ds | restore ds
X+ pop es | restore es
X+ ret | that's all folks!
X+
X+
X+ |*===========================================================================*
X+ |* lock *
X+ |*===========================================================================*
X+ | Disable CPU interrupts. Return old psw as function value.
X+ _lock:
X+ pushf | save flags on stack
X+ cli | disable interrupts
X+ pop ax | return flags for restoration later
X+ ret | return to caller
X+
X+
X+ |*===========================================================================*
X+ |* restore *
X+ |*===========================================================================*
X+ | restore enable/disable bit to the value it had before last lock.
X+ _restore:
X+ push bp | save it
X+ mov bp,sp | set up base for indexing
X+ push 4(bp) | bp is the psw to be restored
X+ popf | restore flags
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+
X+ |*===========================================================================*
X+ |* build_sig *
X+ |*===========================================================================*
X+ |* Build a structure that is pushed onto the stack for signals. It contains
X+ |* pc, psw, etc., and is machine dependent. The format is the same as generated
X+ |* by hardware interrupts, except that after the "interrupt", the signal number
X+ |* is also pushed. The signal processing routine within the user space first
X+ |* pops the signal number, to see which function to call. Then it calls the
X+ |* function. Finally, when the function returns to the low-level signal
X+ |* handling routine, control is passed back to where it was prior to the signal
X+ |* by executing a return-from-interrupt instruction, hence the need for using
X+ |* the hardware generated interrupt format on the stack. The call is:
X+ |* build_sig(sig_stuff, rp, sig)
X+
X+ _build_sig:
X+ push bp | save bp
X+ mov bp,sp | set bp to sp for accessing params
X+ push bx | save bx
X+ push si | save si
X+ mov bx,4(bp) | bx points to sig_stuff
X+ mov si,6(bp) | si points to proc table entry
X+ mov ax,8(bp) | ax = signal number
X+ mov (bx),ax | put signal number in sig_stuff
X+ mov ax,PCREG(si) | ax = signalled process' PC
X+ mov 2(bx),ax | put pc in sig_stuff
X+ mov ax,CSREG(si) | ax = signalled process' cs
X+ mov 4(bx),ax | put cs in sig_stuff
X+ mov ax,PSWREG(si) | ax = signalled process' PSW
X+ mov 6(bx),ax | put psw in sig_stuff
X+ pop si | restore si
X+ pop bx | restore bx
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+
X+ |*===========================================================================*
X+ |* csv & cret *
X+ |*===========================================================================*
X+ | This version of csv replaces the standard one. It checks for stack overflow
X+ | within the kernel in a simpler way than is usually done. cret is standard.
X+ csv:
X+ pop bx | bx = return address
X+ push bp | stack old frame pointer
X+ mov bp,sp | set new frame pointer to sp
X+ push di | save di
X+ push si | save si
X+ sub sp,ax | ax = # bytes of local variables
X+ cmp sp,splimit | has kernel stack grown too large
X+ jbe csv.1 | if sp is too low, panic
X+ jmpreg (bx) | normal return: copy bx to program counter
X+
X+ csv.1:
X+ sub ax,ax | zero
X+ mov splimit,ax | prevent call to panic from aborting in csv
X+ mov bx,_proc_ptr | update rp->p_splimit
X+ mov P_SPLIMIT(bx),ax | rp->sp_limit = 0
X+ push P_NR(bx) | task number
X+ mov ax,#stkoverrun | stack overran the kernel stack area
X+ push ax | push first parameter
X+ call _panic | call is: panic(stkoverrun, task number)
X+ j csv.1 | this should not be necessary
X+
X+ cret:
X+ lea sp,*-4(bp) | set sp to point to saved si
X+ pop si | restore saved si
X+ pop di | restore saved di
X+ pop bp | restore bp
X+ ret | end of procedure
X+
X+ |*===========================================================================*
X+ |* get_chrome *
X+ |*===========================================================================*
X+ | This routine calls the BIOS to find out if the display is monochrome or
X+ | color. The drivers are different, as are the video ram addresses, so we
X+ | need to know.
X+ _get_chrome:
X+ int 0x11 | call the BIOS to get equipment type
X+ andb al,#0x30 | isolate color/mono field
X+ cmpb al,*0x30 | 0x30 is monochrome
X+ je getchr1 | if monochrome then go to getchr1
X+ mov ax,#1 | color = 1
X+ ret | color return
X+ getchr1: xor ax,ax | mono = 0
X+ ret | monochrome return
X+
X+ |*===========================================================================*
X+ |* get_ega *
X+ |*===========================================================================*
X+ | This routine calls the BIOS to find out if the display is ega. This
X+ | is needed because scrolling is different.
X+ _get_ega:
X+ movb bl,*0x10
X+ movb ah,*0x12
X+ int 0x10 | call the BIOS to get equipment type
X+
X+ cmpb bl,*0x10 | if reg is unchanged, it failed
X+ je notega
X+ mov ax,#1 | color = 1
X+ ret | color return
X+ notega: xor ax,ax | mono = 0
X+ ret | monochrome return
X+
X+
X+ |*===========================================================================*
X+ |* vid_copy *
X+ |*===========================================================================*
X+ | This routine takes a string of (character, attribute) pairs and writes them
X+ | onto the screen. For a color display, the writing only takes places during
X+ | the vertical retrace interval, to avoid displaying garbage on the screen.
X+ | The call is:
X+ | vid_copy(buffer, videobase, offset, words)
X+ | where
X+ | 'buffer' is a pointer to the (character, attribute) pairs
X+ | 'videobase' is 0xB800 for color and 0xB000 for monochrome displays
X+ | 'offset' tells where within video ram to copy the data
X+ | 'words' tells how many words to copy
X+ | if buffer is zero, the fill char (blank_color) is used
X+
X+ _vid_copy:
X+ push bp | we need bp to access the parameters
X+ mov bp,sp | set bp to sp for indexing
X+ push si | save the registers
X+ push di | save di
X+ push bx | save bx
X+ push cx | save cx
X+ push dx | save dx
X+ push es | save es
X+ vid.0: mov si,4(bp) | si = pointer to data to be copied
X+ mov es,6(bp) | load es NOW: int routines may NOT ruin it
X+ mov di,8(bp) | di = offset within video ram
X+ and di,_vid_mask | only 4K or 16K counts
X+ mov cx,10(bp) | cx = word count for copy loop
X+ mov dx,#0x3DA | prepare to see if color display is retracing
X+
X+ mov bx,di | see if copy will run off end of video ram
X+ add bx,cx | compute where copy ends
X+ add bx,cx | bx = last character copied + 1
X+ sub bx,_vid_mask | bx = # characters beyond end of video ram
X+ sub bx,#1 | note: dec bx doesn't set flags properly
X+ | it DOES for jle!!
X+ jle vid.1 | jump if no overrun
X+ sar bx,#1 | bx = # words that don't fit in video ram
X+ sub cx,bx | reduce count by overrun
X+
X+ vid.1: push cx | save actual count used for later
X+ testb _snow,#1 | skip vertical retrace test if no snow
X+ jz vid.4
X+
X+ |vid.2: in | with a color display, you can only copy to
X+ | test al,*010 | the video ram during vertical retrace, so
X+ | jnz vid.2 | wait for start of retrace period. Bit 3 of
X+ vid.3: in | 0x3DA is set during retrace. First wait
X+ testb al,*010 | until it is off (no retrace), then wait
X+ jz vid.3 | until it comes on (start of retrace)
X+
X+ vid.4: cmp si,#0 | si = 0 means blank the screen
X+ je vid.7 | jump for blanking
X+ lock | this is a trick for the IBM PC simulator only
X+ inc vidlock | 'lock' indicates a video ram access
X+ rep | this is the copy loop
X+ movw | ditto
X+
X+ vid.5: pop si | si = count of words copied
X+ cmp bx,#0 | if bx < 0, then no overrun and we are done
X+ jle vid.6 | jump if everything fit
X+ mov 10(bp),bx | set up residual count
X+ mov 8(bp),#0 | start copying at base of video ram
X+ cmp 4(bp),#0 | NIL_PTR means store blanks
X+ je vid.0 | go do it
X+ add si,si | si = count of bytes copied
X+ add 4(bp),si | increment buffer pointer
X+ j vid.0 | go copy some more
X+
X+ vid.6: pop es | restore registers
X+ pop dx | restore dx
X+ pop cx | restore cx
X+ pop bx | restore bx
X+ pop di | restore di
X+ pop si | restore si
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+ vid.7: mov ax,_blank_color | ax = blanking character
X+ rep | copy loop
X+ stow | blank screen
X+ j vid.5 | done
X+
X+ |*===========================================================================*
X+ |* wait_retrace *
X+ |*===========================================================================*
X+ | Wait until we're in the retrace interval. Return locked (ints off).
X+ | But enable them during the wait.
X+
X+ _wait_retrace: push dx
X+ pushf
X+ mov dx,_vid_port
X+ or dx,#0x0A
X+ wtre.3: sti
X+ nop
X+ nop
X+ cli
X+ in | 0x3DA bit 3 is set during retrace.
X+ testb al,*010 | Wait until it is on.
X+ jz wtre.3
X+
X+ pop ax | return flags for restoration later
X+ pop dx
X+ ret | return to caller
X+
X+ |*===========================================================================*
X+ |* scr_up *
X+ |*===========================================================================*
X+ | This routine scrolls the screen up one line
X+ |
X+ | The call is:
X+ | scr_up(videoseg,source,dest,count)
X+ | where
X+ | 'videoseg' is the segment of screen memory
X+
X+ _scr_up:
X+ push bp | we need bp to access the parameters
X+ mov bp,sp | set bp to sp for indexing
X+ push si | save the registers
X+ push di | save di
X+ push cx | save cx
X+ push es | save es
X+ push ds | save ds
X+ mov si,6(bp) | si = pointer to data to be copied
X+ mov di,8(bp) | di = offset within video ram
X+ mov cx,10(bp) | cx = word count for copy loop
X+
X+ mov ax,4(bp) | set source and target segments to videoseg
X+ mov ds,ax
X+ mov es,ax
X+
X+ rep | this is the copy loop
X+ movw | ditto
X+
X+ pop ds | restore ds
X+ pop es | restore es
X+ pop cx | restore cx
X+ pop di | restore di
X+ pop si | restore si
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+ |*===========================================================================*
X+ |* scr_down *
X+ |*===========================================================================*
X+ | This routine scrolls the screen down one line
X+ |
X+ | The call is:
X+ | scr_down(vidoeseg,source,dest,count)
X+ | where
X+ | 'videoseg' is the segment of screen memory
X+
X+ _scr_down:
X+ push bp | we need bp to access the parameters
X+ mov bp,sp | set bp to sp for indexing
X+ push si | save the registers
X+ push di | save di
X+ push cx | save cx
X+ push es | save es
X+ push ds | save ds
X+ mov si,6(bp) | si = pointer to data to be copied
X+ mov di,8(bp) | di = offset within video ram
X+ mov cx,10(bp) | cx = word count for copy loop
X+
X+ mov ax,4(bp) | set source and target segments to videoseg
X+ mov ds,ax
X+ mov es,ax
X+
X+ std | reverse to avoid propagating 1st word
X+ rep | this is the copy loop
X+ movw | ditto
X+
X+ cld | restore direction flag to known state
X+ pop ds | restore ds
X+ pop es | restore es
X+ pop cx | restore cx
X+ pop di | restore di
X+ pop si | restore si
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+
X+ |===========================================================================
X+ | em_xfer
X+ |===========================================================================
X+ |
X+ | This file contains one routine which transfers words between user memory
X+ | and extended memory on an AT or clone. A BIOS call (INT 15h, Func 87h)
X+ | is used to accomplish the transfer. The BIOS call is "faked" by pushing
X+ | the processor flags on the stack and then doing a far call through the
X+ | saved vector table to the actual BIOS location. An actual INT 15h would
X+ | get a MINIX complaint from an unexpected trap.
X+
X+ | This particular BIOS routine runs with interrupts off since the 80286
X+ | must be placed in protected mode to access the memory above 1 Mbyte.
X+ | So there should be no problems using the BIOS call, except it may take
X+ | too long and cause interrupts to be lost.
X+ |
X+ .text
X+ gdt: | Begin global descriptor table
X+ | Dummy descriptor
X+ .word 0 | segment length (limit)
X+ .word 0 | bits 15-0 of physical address
X+ .byte 0 | bits 23-16 of physical address
X+ .byte 0 | access rights byte
X+ .word 0 | reserved
X+ | descriptor for GDT itself
X+ .word 0 | segment length (limit)
X+ .word 0 | bits 15-0 of physical address
X+ .byte 0 | bits 23-16 of physical address
X+ .byte 0 | access rights byte
X+ .word 0 | reserved
X+ src: | source descriptor
X+ srcsz: .word 0 | segment length (limit)
X+ srcl: .word 0 | bits 15-0 of physical address
X+ srch: .byte 0 | bits 23-16 of physical address
X+ .byte 0x93 | access rights byte
X+ .word 0 | reserved
X+ tgt: | target descriptor
X+ tgtsz: .word 0 | segment length (limit)
X+ tgtl: .word 0 | bits 15-0 of physical address
X+ tgth: .byte 0 | bits 23-16 of physical address
X+ .byte 0x93 | access rights byte
X+ .word 0 | reserved
X+ | BIOS CS descriptor
X+ .word 0 | segment length (limit)
X+ .word 0 | bits 15-0 of physical address
X+ .byte 0 | bits 23-16 of physical address
X+ .byte 0 | access rights byte
X+ .word 0 | reserved
X+ | stack segment descriptor
X+ .word 0 | segment length (limit)
X+ .word 0 | bits 15-0 of physical address
X+ .byte 0 | bits 23-16 of physical address
X+ .byte 0 | access rights byte
X+ .word 0 | reserved
X+
X+ |
X+ |
X+ | Execute a transfer between user memory and extended memory.
X+ |
X+ | status = em_xfer(source, dest, count);
X+ |
X+ | Where:
X+ | status => return code (0 => OK)
X+ | source => Physical source address (32-bit)
X+ | dest => Physical destination address (32-bit)
X+ | count => Number of words to transfer
X+ |
X+ |
X+ |
X+ _em_xfer:
X+ push bp | Save registers
X+ mov bp,sp
X+ push si
X+ push es
X+ push cx
X+ |
X+ | Pick up source and destination addresses and update descriptor tables
X+ |
X+ mov ax,4(bp)
X+ seg cs
X+ mov srcl,ax
X+ mov ax,6(bp)
X+ seg cs
X+ movb srch,al
X+ mov ax,8(bp)
X+ seg cs
X+ mov tgtl,ax
X+ mov ax,10(bp)
X+ seg cs
X+ movb tgth,al
X+ |
X+ | Update descriptor table segment limits
X+ |
X+ mov cx,12(bp)
X+ mov ax,cx
X+ add ax,ax
X+ seg cs
X+ mov tgtsz,ax
X+ seg cs
X+ mov srcsz,ax
X+
X+ | The BIOS call doesn't preserve the flags!!!
X+ | Worse, it enables interrupts internally.
X+ | This mainly hurts the call from db via p_dmp() and phys_copy(), which
X+ | is only invoked for protected mode.
X+ | Disable interrupts using the interrupt controller, and save the flags.
X+ | On 386's, the extended flags and registers are destroyed.
X+
X+ in INT_CTLMASK
X+ push ax
X+ movb al,#0xFF | mask everything
X+ out INT_CTLMASK
X+ pushf
X+
X+ |
X+ | Now do actual DOS call
X+ |
X+ push cs
X+ pop es
X+ mov si,#gdt
X+ movb ah,#EM_XFER_FUNC
X+ pushf | fake interrupt
X+ callfarptr(_vec_table+4*EM_XFER_VEC)
X+
X+ | Restore flags and interrupt controller.
X+
X+ popf
X+ pop ax
X+ out INT_CTLMASK
X+
X+ |
X+ | All done, return to caller.
X+ |
X+
X+ pop cx | restore registers
X+ pop es
X+ pop si
X+ mov sp,bp
X+ pop bp
X+ ret
X+
X+ |*===========================================================================
X+ |* ack_char
X+ |*===========================================================================
X+ | Acknowledge character from keyboard for PS/2
X+
X+ _ack_char:
X+ push dx
X+ mov dx,#0x69
X+ in
X+ xor ax,#0x10
X+ out
X+ xor ax,#0x10
X+ out
X+
X+ mov dx,#0x66
X+ movb ah,#0x10
X+ in
X+ notb ah
X+ andb al,ah
X+ out
X+ jmp frw1
X+ frw1: notb ah
X+ orb al,ah
X+ out
X+ jmp frw2
X+ frw2: notb ah
X+ andb al,ah
X+ out
X+
X+ pop dx
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* save_tty_vec *
X+ |*===========================================================================*
X+ | Save the tty vector 0x71 (PS/2)
X+ _save_tty_vec:
X+ push es
X+ xor ax,ax
X+ mov es,ax
X+ seg es
X+ mov ax,452
X+ mov tty_vec1,ax
X+ seg es
X+ mov ax,454
X+ mov tty_vec2,ax
X+ pop es
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* reboot & wreboot *
X+ |*===========================================================================*
X+ | This code reboots the PC
X+
X+ _reboot:
X+ cli | disable interrupts
X+ mov ax,#0x20 | re-enable interrupt controller
X+ out 0x20
X+ call _eth_stp | stop the ethernet chip
X+
X+ cmp _pc_at,#0
X+ jz old_reboot
X+ new_reboot:
X+ sub bx,bx | phys_copy(reboot_magic, 0x472L, 2L)
X+ mov ax,#2 | to stop memory test
X+ push bx | can't load ds = 0x40 in protected mode
X+ push ax | push 2L
X+ mov ax,#0x472
X+ push bx | push 0x472L
X+ push ax
X+ seg cs
X+ mov ax,kernel_ds | need real ds not necessarily current ds
X+ movb cl,#HCLICK_SHIFT | calculate bx:ax = ax * HCLICK_SHIFT
X+ rol ax,cl
X+ movb bl,al
X+ andb bl,#HCHIGH_MASK
X+ andb al,#HCLOW_MASK
X+ add ax,#reboot_magic | then bx:ax += &reboot_magic
X+ adc bx,#0
X+ push bx
X+ push ax
X+ call _phys_copy
X+ movb al,#0xFE | complemented 0x01 bit
X+ out 0x64 | tells keyboard controller to reset processor
X+
X+ | That should do it for AT's. A solution for PS/2's remains to be found.
X+
X+ old_reboot:
X+ call resvec | restore the vectors in low core
X+ into_reboot:
X+ mov ax,#0x40
X+ push ds
X+ mov ds,ax
X+ mov ax,#0x1234
X+ mov 0x72,ax
X+ pop ds
X+ test _ps,#0xFFFF
X+ jnz r.1
X+ mov ax,#0xFFFF
X+ mov ds,ax
X+ mov ax,3
X+ push ax
X+ mov ax,1
X+ push ax
X+ reti
X+ r.1:
X+ mov ax,_port_65 | restore port 0x65
X+ mov dx,#0x65
X+ out
X+ mov dx,#0x21 | restore interrupt mask port
X+ mov ax,#0xBC
X+ out
X+ sti | enable interrupts
X+ int 0x19 | for PS/2 call bios to reboot
X+
X+ _wreboot:
X+ cli | disable interrupts
X+ mov ax,#0x20 | re-enable interrupt controller
X+ out 0x20
X+ call _eth_stp | stop the ethernet chip
X+
X+ cmp _pc_at,#0
X+ jz old_wreboot
X+ call _scan_keyboard | ack any old input
X+ waitkey:
X+ in 0x64 | test this keyboard status port
X+ testb al,#0x01 | this bit is set when data is ready
X+ jz waitkey
X+ j new_reboot
X+
X+ old_wreboot:
X+ call resvec | restore the vectors in low core
X+ mov ax,#0x70 | restore the standard interrupt bases
X+ push ax
X+ mov ax,#8
X+ push ax
X+ call _init_8259
X+ pop ax
X+ pop ax
X+ movb al,#notop(KEYBOARD_MASK) | allow keyboard int (only)
X+ out INT_CTLMASK | after sti in int 0x16
X+ xor ax,ax | wait for character before continuing
X+ int 0x16 | get char
X+ j into_reboot
X+
X+ | Restore the interrupt vectors in low core.
X+ resvec:
X+ mov cx,#2*71
X+ mov si,#_vec_table
X+ xor di,di
X+ mov es,di
X+ rep
X+ movw
X+
X+ mov ax,tty_vec1 | Restore keyboard interrupt vector for PS/2
X+ seg es
X+ mov 452,ax
X+ mov ax,tty_vec2
X+ seg es
X+ mov 454,ax
X+
X+ ret
X+
X+ | Some library routines use exit, so this label is needed.
X+ | Actual calls to exit cannot occur in the kernel.
X+ | Same for .fat
X+ | Same for .trp.
X+
X+ .fat:
X+ .trp:
X+ _exit: sti
X+ j _exit
X+
X+ .data
X+ vidlock: .word 0 | dummy variable for use with lock prefix
X+ splimit: .word 0 | stack limit for current task (kernel only)
X+ stkoverrun: .ascii "Kernel stack overrun, task = "
X+ .byte 0
X+ em_bad: .ascii "Bad call to phys_copy with extended memory, error "
X+ .byte 0
X+ .space 3 | align
X+ _vec_table: .space VECTOR_BYTES | storage for interrupt vectors
X+ tty_vec1: .word 0 | storage for vector 0x71 (offset)
X+ tty_vec2: .word 0 | storage for vector 0x71 (segment)
X+ reboot_magic: .word 0x1234 | to stop memory test
X+ .space 2 | align
X+
X+ .text
X+ |*===========================================================================*
X+ |* check_mem *
X+ |*===========================================================================*
X+
X+ | PUBLIC phys_bytes check_mem(phys_bytes base, phys_bytes size);
X+ | Check a block of memory, return the valid size.
X+ | Only every 16th byte is checked.
X+ | The memory and initial size must be <= 1M for non-protected mode.
X+ | An initial size of 0 means everything.
X+ | This really should do some alias checks.
X+
X+ _check_mem:
X+ push bp
X+ mov bp,sp
X+ push ds
X+ mov dx,4+2(bp) | base in dx:ax
X+ sub ax,ax | prepare for early exit
X+ test dx,#notop(HCHIGH_MASK)
X+ jnz cm_1exit | can't handle bases above 1M
X+ mov ax,4(bp) | ax = base segment = base / 16 % 0x10000
X+ andb al,#HCLOW_MASK
X+ orb al,dl
X+ movb cl,#HCLICK_SHIFT
X+ ror ax,cl
X+ mov bx,4+4(bp) | size in dx:bx
X+ mov dx,4+4+2(bp)
X+ test dx,#notop(HCHIGH_MASK)
X+ jz over_cm_reduce
X+ movb dl,#HCHIGH_MASK
X+ mov bx,#0xFFFF
X+ over_cm_reduce:
X+ andb bl,#HCLOW_MASK | cx = size in hclicks = size / 16 % 0x10000
X+ orb bl,dl
X+ ror bx,cl
X+ mov cx,bx
X+ push cx | save size in clicks
X+ mov bx,4(bp) | bx = base offset = base % 16
X+ and bx,#OFF_MASK
X+ cm_loop:
X+ mov ds,ax
X+ movb dl,#TEST1PATTERN
X+ xchgb dl,(bx) | write test pattern, remember original value
X+ xchgb dl,(bx) | restore original value, read test pattern
X+ cmpb dl,#TEST1PATTERN | must agree if good real memory
X+ jnz cm_exit | if different, memory is unusable
X+ movb dl,#TEST2PATTERN
X+ xchgb dl,(bx)
X+ xchgb dl,(bx)
X+ cmpb dl,#TEST2PATTERN
X+ jnz cm_exit
X+ inc ax | next segment, test for wraparound at 1M
X+ loopnz cm_loop
X+ cm_exit:
X+ pop ax
X+ sub ax,cx | verified size in phys_clicks
X+ cm_1exit:
X+ movb dl,ah | convert to phys_bytes in dx:ax
X+ movb cl,#HCLICK_SHIFT
X+ shl ax,cl
X+ shr dx,cl
X+ and dx,#HCHIGH_MASK
X+ pop ds
X+ pop bp
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* cim_at_wini *
X+ |* cim_floppy *
X+ |* cim_printer *
X+ |* cim_xt_wini *
X+ |*===========================================================================*
X+
X+ | All these routines are meant to be called from the task level where
X+ | interrupts should not be globally disabled, so they return with interrupts
X+ | enabled.
X+
X+ | PUBLIC void cim_at_wini();
X+ | Clear the AT winchester interrupt mask.
X+
X+ _cim_at_wini:
X+ cli
X+ in INT2_MASK
X+ andb al,#notop(AT_WINI_MASK)
X+ out INT2_MASK
X+ sti
X+ ret
X+
X+ | PUBLIC void cim_floppy();
X+ | Clear the AT winchester interrupt mask.
X+
X+ .define _cim_floppy
X+ _cim_floppy:
X+ cli
X+ in INT_CTLMASK
X+ andb al,#notop(FLOPPY_MASK)
X+ out INT_CTLMASK
X+ sti
X+ ret
X+
X+ | PUBLIC void cim_printer();
X+ | Clear the printer interrupt mask.
X+
X+ _cim_printer:
X+ cli
X+ in INT_CTLMASK
X+ #ifdef ASLD
X+ andb al,#notop(PRINTER_MASK)
X+ #else
X+ andb al,#notop(PRINTER_MASK) & 0xFF
X+ #endif
X+ out INT_CTLMASK
X+ sti
X+ ret
X+
X+ | PUBLIC void cim_xt_wini();
X+ | Clear the xt_wini interrupt mask.
X+
X+ _cim_xt_wini:
X+ cli
X+ in INT_CTLMASK
X+ andb al,#notop(XT_WINI_MASK)
X+ out INT_CTLMASK
X+ sti
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* get_extmemsize *
X+ |*===========================================================================*
X+
X+ | PUBLIC void get_extmemsize();
X+ | Ask the BIOS how much extended memory there is.
X+
X+ _get_extmemsize:
X+ movb ah,#GET_EXTMEM_FUNC
X+ int GET_EXTMEM_VEC | returns size (in K) in ax for AT's
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* get_phys_byte *
X+ |*===========================================================================*
X+
X+ | PUBLIC int get_phys_byte(phys_bytes offset);
X+ | Fetch a byte from anywhere in memory.
X+ | Get_byte() was inadequate above 1MB and the segment arithmetic to set up
X+ | its arguments used the wrong CLICK_SIZE.
X+ | This and its protected mode version provide a uniform interface.
X+
X+ _get_phys_byte:
X+ pop dx | return addr
X+ pop ax | source addr in cx:ax
X+ pop cx
X+ sub sp,#4 | adjust for parameter popped
X+ mov bx,ax | bx = source offset = address % 16
X+ and bx,#OFF_MASK
X+ andb cl,#HCHIGH_MASK | ds = source segment = address / 16 % 0x10000
X+ andb al,#HCLOW_MASK
X+ orb al,cl
X+ movb cl,#HCLICK_SHIFT
X+ ror ax,cl
X+ mov cx,ds | save ds
X+ mov ds,ax
X+ movb al,(bx) | fetch the byte
X+ subb ah,ah | zero-extend to int
X+ mov ds,cx
X+ jmpreg (dx)
X+
X+
X+ |*===========================================================================*
X+ |* get_memsize *
X+ |*===========================================================================*
X+
X+ | PUBLIC void get_memsize();
X+ | Ask the BIOS how much normal memory there is.
X+
X+ _get_memsize:
X+ int GET_MEM_VEC | this returns the size (in K) in ax
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* phys_copy *
X+ |*===========================================================================*
X+
X+ | PUBlIC void phys_copy( long source, long destination, long bytecount);
X+ | Copy a block of physical memory.
X+
X+ DESTLO = 8
X+ DESTHI = 10
X+ SRCLO = 4
X+ SRCHI = 6
X+ COUNTLO = 12
X+ COUNTHI = 14
X+
X+ _phys_copy:
X+ push bp | save only registers required by C
X+ mov bp,sp | set bp to point to source arg less 4
X+
X+ | check for extended memory
X+
X+ mov ax,SRCHI(bp)
X+ or ax,DESTHI(bp)
X+ test ax,#EM_MASK
X+ jnz to_em_xfer
X+
X+ push si | save si
X+ push di | save di
X+ push ds | save ds
X+ push es | save es
X+
X+ mov ax,SRCLO(bp) | dx:ax = source address (dx is NOT segment)
X+ mov dx,SRCHI(bp)
X+ mov si,ax | si = source offset = address % 16
X+ and si,#OFF_MASK
X+ | andb dl,#HCHIGH_MASK | ds = source segment = address / 16 % 0x10000
X+ | mask is unnecessary because of EM_MASK test
X+ andb al,#HCLOW_MASK
X+ orb al,dl | now bottom 4 bits of dx are in ax
X+ movb cl,#HCLICK_SHIFT | rotate them to the top 4
X+ ror ax,cl
X+ mov ds,ax
X+
X+ mov ax,DESTLO(bp) | dx:ax = destination addr (dx is NOT segment)
X+ mov dx,DESTHI(bp)
X+ mov di,ax | di = dest offset = address % 16
X+ and di,#OFF_MASK
X+ | andb dl,#HCHIGH_MASK | es = dest segment = address / 16 % 0x10000
X+ andb al,#HCLOW_MASK
X+ orb al,dl
X+ ror ax,cl
X+ mov es,ax
X+
X+ mov ax,COUNTLO(bp) | dx:ax = remaining count
X+ mov dx,COUNTHI(bp)
X+
X+ | copy upwards (can't handle overlapped copy)
X+
X+ pc_loop:
X+ mov cx,ax | provisional count for this iteration
X+ test ax,ax | if count >= 0x8000, only do 0x8000 per iter
X+ js pc_bigcount | low byte already >= 0x8000
X+ test dx,dx
X+ jz pc_upcount | less than 0x8000
X+ pc_bigcount:
X+ mov cx,#0x8000 | use maximum count per iteration
X+ pc_upcount:
X+ sub ax,cx | update count
X+ sbb dx,#0 | can't underflow, so carry clear now for rcr
X+ rcr cx,#1 | count in words, carry remembers if byte
X+ jnc pc_even | no odd byte
X+ movb | copy odd byte
X+ pc_even:
X+ rep | copy 1 word at a time
X+ movw | word copy
X+
X+ mov cx,ax | test if remaining count is 0
X+ or cx,dx
X+ jnz pc_more | more to do
X+
X+ pop es | restore es
X+ pop ds | restore ds
X+ pop di | restore di
X+ pop si | restore si
X+ pop bp | restore bp
X+ ret | return to caller
X+
X+ pc_more:
X+ sub si,#0x8000 | adjust pointers so the offset doesn't
X+ mov cx,ds | overflow in the next 0x8000 bytes
X+ add cx,#0x800 | pointers end up same physical location
X+ mov ds,cx | the current offsets are known >= 0x8000
X+ sub di,#0x8000 | since we just copied that many
X+ mov cx,es
X+ add cx,#0x800
X+ mov es,cx
X+ j pc_loop | start next iteration
X+
X+ to_em_xfer: | source or target is above 1M, join em_xfer
X+ sub bx,bx | build error code here
X+ mov ax,COUNTHI(bp) | convert count to words
X+ rcr ax,#1 | carry is clear from previous test instruct
X+ rcr COUNTLO(bp),#1
X+ pop bp | stack frame now agrees with em_xfer's
X+ jc pc_panic | count was odd
X+ inc bx
X+ test ax,ax
X+ jnz pc_panic | count is too big
X+ inc bx
X+ cmp _processor,#286
X+ jb pc_panic | not 286 or 386
X+ jmp _em_xfer
X+
X+ pc_panic:
X+ push bx | error code
X+ mov ax,#em_bad | string to print
X+ push ax
X+ call _panic
X+ pc_1panic:
X+ j pc_1panic | this should not be necessary
X+
X+
X+ |*===========================================================================*
X+ |* porti_out *
X+ |*===========================================================================*
X+
X+ | PUBLIC void porti_out(int portpair, int indexpair, int datapair);
X+ | Set a port-index pair. For hardware like 6845's.
X+
X+ _porti_out:
X+ pop cx | return adr
X+ pop dx | portpair
X+ pop ax | indexpair
X+ pop bx | datapair
X+ sub sp,#6 | adjust for 3 parameters popped
X+ xchgb ah,bl | low byte of data in ah, high index in bl
X+ pushf | don't let interrupt separate the halves
X+ cli
X+ outw | low index and data at once
X+ | (may depend on 8 bit bus & speed?)
X+ xchg ax,bx | high index in al, high byte of data in ah
X+ outw | high index and data at once
X+ popf
X+ jmpreg (cx)
X+
X+
X+ |*===========================================================================*
X+ |* port_read *
X+ |*===========================================================================*
X+
X+ | PUBLIC void port_read(port_t port, long destination, unsigned bytcount);
X+ | Transfer data from (hard disk controller) port to memory.
X+
X+ _port_read:
X+ push bp
X+ mov bp,sp
X+ push cx
X+ push dx
X+ push di
X+ push es
X+ mov ax,4+2(bp) | destination addr in dx:ax
X+ mov dx,4+2+2(bp)
X+ mov di,ax | di = dest offset = address % 16
X+ and di,#OFF_MASK
X+ andb dl,#HCHIGH_MASK | es = dest segment = address / 16 % 0x10000
X+ andb al,#HCLOW_MASK
X+ orb al,dl
X+ movb cl,#HCLICK_SHIFT
X+ ror ax,cl
X+ mov es,ax
X+
X+ mov cx,4+2+4(bp) | count in bytes
X+ shr cx,#1 | count in words
X+ mov dx,4(bp) | port to read from
X+ rep
X+ insw
X+ pop es
X+ pop di
X+ pop dx
X+ pop cx
X+ mov sp,bp
X+ pop bp
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* port_write *
X+ |*===========================================================================*
X+
X+ | PUBLIC void port_write(port_t port, long source, unsigned bytcount);
X+ | Transfer data from memory to (hard disk controller) port.
X+
X+ _port_write:
X+ push bp
X+ mov bp,sp
X+ push cx
X+ push dx
X+ push si
X+ push ds
X+ mov ax,4+2(bp) | source addr in dx:ax
X+ mov dx,4+2+2(bp)
X+ mov si,ax | di = source offset = address % 16
X+ and si,#OFF_MASK
X+ andb dl,#HCHIGH_MASK | ds = source segment = address / 16 % 0x10000
X+ andb al,#HCLOW_MASK
X+ orb al,dl
X+ movb cl,#HCLICK_SHIFT
X+ ror ax,cl
X+ mov ds,ax
X+ mov cx,4+2+4(bp) | count in bytes
X+ shr cx,#1 | count in words
X+ mov dx,4(bp) | port to read from
X+ rep
X+ outsw
X+ pop ds
X+ pop si
X+ pop dx
X+ pop cx
X+ mov sp,bp
X+ pop bp
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* sim_printer *
X+ |*===========================================================================*
X+
X+ | PUBLIC void sim_printer();
X+ | Set the printer interrupt mask.
X+ | This is meant to be called from the task level, so it returns with
X+ | interrupts enabled, like cim_printer().
X+
X+ _sim_printer:
X+ cli
X+ in INT_CTLMASK
X+ orb al,#PRINTER_MASK
X+ out INT_CTLMASK
X+ sti
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* tasim_printer *
X+ |*===========================================================================*
X+
X+ | PUBLIC int tasim_printer();
X+ | Set the printer interrupt mask, indivisibly with getting its old value.
X+ | Return old value.
X+ | Although this is meant to be called from the clock interrupt handler via
X+ | a call to pr_restart(), it returns with interrupts enabled since the
X+ | clock handler has them enabled.
X+ | This might not work for multiple processors, unlike test_and_set().
X+
X+ _tasim_printer:
X+ cli
X+ in INT_CTLMASK
X+ movb ah,al
X+ orb al,#PRINTER_MASK
X+ out INT_CTLMASK
X+ sti
X+ movb al,ah
X+ and ax,#PRINTER_MASK
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* test_and_set *
X+ |*===========================================================================*
X+
X+ | PUBLIC int test_and_set( int *flag );
X+ | Set the flag to TRUE, indivisibly with getting its old value.
X+ | Return old flag.
X+
X+ _test_and_set:
X+ pop dx
X+ pop bx
X+ sub sp,#2
X+ mov ax,#1
X+ xchg ax,(bx)
X+ jmpreg (dx)
X+
X+
X+ |*===========================================================================*
X+ |* unlock *
X+ |*===========================================================================*
X+
X+ | PUBLIC void unlock();
X+ | Enable CPU interrupts.
X+
X+ _unlock:
X+ sti | enable interrupts
X+ ret | return to caller
X+
X+
X+ #ifndef DEBUGGER
X+
X+ |*===========================================================================*
X+ |* codeseg *
X+ |*===========================================================================*
X+
X+ | PUBLIC phys_clicks codeseg();
X+ | Return the current code segment.
X+
X+ _codeseg:
X+ mov ax,cs
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* dataseg *
X+ |*===========================================================================*
X+
X+ | PUBLIC phys_clicks dataseg();
X+ | Return the current data segment.
X+
X+ _dataseg:
X+ mov ax,ds
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* get_processor *
X+ |*===========================================================================*
X+
X+ | PUBLIC unsigned get_processor();
X+ | Decide processor type among 8088=8086, 80188=80186, 80286, 80386.
X+ | Return 86, 186, 286 or 386.
X+ | Preserves all registers except the flags and the return register ax.
X+
X+ | Method:
X+ | 8088=8086 and 80188=80186 push sp as new sp, 80286 and 80386 as old sp.
X+ | All but 8088=8086 do shifts mod 32 or 16.
X+ | 386 stores 0 for the upper 8 bits of the GDT pointer in 16 bit mode,
X+ | while 286 stores 0xFF.
X+
X+ _get_processor:
X+ push sp
X+ pop ax
X+ cmp ax,sp
X+ jz new_processor
X+ push cx
X+ mov cx,#0x0120
X+ shlb ch,cl | zero tells if 86
X+ pop cx
X+ mov ax,#86
X+ jz got_processor
X+ mov ax,#186
X+ ret
X+
X+ new_processor:
X+ push bp
X+ mov bp,sp
X+ sub sp,#6 | space for GDT ptr
X+ defsgdt (-6(bp)) | save 3 word GDT ptr
X+ add sp,#4 | discard 2 words of GDT ptr
X+ pop ax | top word of GDT ptr
X+ pop bp
X+ cmpb ah,#0 | zero only for 386
X+ mov ax,#286
X+ jnz got_processor
X+ mov ax,#386
X+ got_processor:
X+ ret
X+
X+
X+ |*===========================================================================*
X+ |* inportb *
X+ |*===========================================================================*
X+
X+ | PUBLIC unsigned inportb( port_t port );
X+ | Read an (unsigned) byte from the i/o port port and return it.
X+
X+ _inportb:
X+ pop bx
X+ pop dx
X+ dec sp
X+ dec sp
X+ in
X+ subb ah,ah
X+ jmpreg (bx)
X+
X+ #endif /* DEBUGGER */
END_OF_FILE
if test 39670 -ne `wc -c <'kerneldif/klib88.x.cdif'`; then
echo shar: \"'kerneldif/klib88.x.cdif'\" unpacked with wrong size!
fi
# end of 'kerneldif/klib88.x.cdif'
fi
echo shar: End of archive 5 \(of 10\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 10 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Division of Information Technology (Melbourne), Phone +61 3 347 8644
C.S.I.R.O. Fax +61 3 347 8987
55 Barry St. Telex AA 152914
Carlton, Vic, 3053, Australia E-mail: worsley@ditmela.oz.au