pcs/pro2real.asm

;							=====> PRO2REAL.ASM
; PC Scheme Protected Mode -> Real Mode Interface
; (c) 1987 by Texas Instruments Incorporated  --  all rights reserved
;
; This Module contains code which interfaces to external programs via
; either the External Language Interface (XLI), Software Interrupt,
; or the Real Procedure Call (RPC). The RPC is specific to protected
; mode scheme only, and is used to implement XLI.

; Author:  Terry Caudill (from Bob Beal's original source)
; History:
;   rb  3/20/87 - original
;   tc  8/7/87  - to work in protected mode scheme
;   tc 10/13/87 - cleanup


	  page	  84,120
	  name	  EXTPROG
	  title   PC Scheme External Program Interface
	  .286c


	  subttl  Includes and Local Equates
	  page

	  include scheme.equ
	  include sinterp.arg
	  include xli.equ
	  include xli_pro.mac
	  include rpc.equ

;
; Dos function requests
;
DOS	   equ 021h			; Dos Function Request
DELETE_SEG equ 04900h			; Delete Segment
REAL_INTRP equ 0E3h			; Issue Real Interrupt  - from AIA
BLOCK_XFER equ 0EC00h			; Block	Transfer 	- from AIA
ALLOC_REAL equ 0E802h			; Create Real Data Seg  - from AIA
CREATE_WIN equ 0E803h			; Create Real Window    - from AIA


	  subttl  Group and Constant definitions
	  page
pgroup	  group   prog
xgroup	  group   progx
dgroup	  group   data


	  subttl  Data segment definitions
	  page

data	  segment para public 'DATA'
	  assume  ds:dgroup
	  public  rpc_handle
	  public  REAL_MODE_BUFFER,REAL_BUF_OFFSET,REAL_BUF_SELECTOR
	  public  REAL_BUF_PARA,REAL_BUF_TOP
	  public  C_fn
	  public  mem_entry,mem_table
; external variables
	  extrn   ctl_file:word,pcs_sysd:word
	  extrn   regs:word
	  extrn	  vid_mode:word,char_hgt:word

;
; The following data definitions are used in communication with real
; mode procedures and the real procedure call (RPC) mechanism provided
; in OS/286 by AI Architects.
;

rpc_real     db	"realschm.exe",0	; Name of RPC file to load
rpc_real_len equ $-rpc_real

rpc_handle   db	0			; Handle to real mode scheme routines
rpc_loaded   db 0			; Flag to note if rpc load was successful
rpc_saved_sp dw	?			; Saved stack pointer

REAL_MODE_BUFFER   equ $		; selector and offset of real mode
REAL_BUF_OFFSET    dw 0			; offset of real mode buffer
REAL_BUF_SELECTOR  dw 0			; segment selector of real mode buffer
REAL_BUF_PARA	   dw 0			; segment address of real mode buffer
REAL_BUF_TOP	   dw 0			; note buffer top

;
; The following are xli filenames which must be loaded and used by pcs
;
io_exe       db	"realio.exe" ,0           ;EXE file providing I/O support	
io_exe_len   equ $-io_exe

graph_exe    db	"graphics.exe" ,0         ;EXE file providing graphics support	
graph_exe_len equ $-graph_exe

trig_exe     db	"newtrig.exe" ,0          ;EXE file providing trig support	
trig_exe_len equ $-trig_exe

;
; The following table is used to load the system files required by pcs. The
; xli system files are order dependent. 
sys_files    equ $
;system xli files, order is dependent (see rpc.equ and realschm.asm)
	     dw	 io_exe,io_exe_len        ;io support       - xli system file
	     dw  graph_exe,graph_exe_len  ;graphics support - xli system file
;normal xli files
normal_files equ $
	     dw	 trig_exe,trig_exe_len	  ;trig file        - normal xli file
	     dw  0
;
; If the above files cannot be found, issue this message and abort scheme
;
FILERR	     db  0Dh,0Ah,"Fatal Error - unable to load file "
FILNAM	     db  20 dup (0)

;
; The following table contains gateways from the prog segment to the
; progx segment. The order is dependent on
; Table of RPC functions currently defined. Calling any of these functions
; requires synchronization with the real mode routine.
;
FAR_RPC	     equ	$
frpc_bid     equ	$-FAR_RPC
	     dw	init_rpc,progx		; bid real procedure
frpc_init    equ	$-FAR_RPC
     	     dw	xpcinit,progx		; get machine type
frpc_setcrt  equ	$-FAR_RPC
     	     dw	xsetcrt,progx		; set crt interrupt
frpc_resetcrt equ	$-FAR_RPC
     	     dw	xresetcrt,progx		; reset crt interrupt
frpc_ldall   equ	$-FAR_RPC
      	     dw	load_all,progx		; load xli files
frpc_unld    equ	$-FAR_RPC
     	     dw	unload_all,progx	; unload xli files
frpc_xesc    equ	$-FAR_RPC
     	     dw	xesc,progx		; perform xesc call

;
; The following hooks are used to call routines in the PROG segment
; from the PROGX segment. See the far_C routine in this module.
;
C_fn	     dw  ?	      		
C_retadr     dw  ?			; Used to call C routines from PROGX
	     dw  ?	

;
; Mem_table is used to hold selectors to real memory which must be allocated
; over the life of an xli call. At present, the memory is allocated so that
; xli routines may access far strings. See SSR within.
;
mem_entry    dw	 0		;entry into memory table
mem_table    dw	 N_ARGS dup (0)	;record memory allocated during xli call

;
; The following structures allow xesc and sw-int to share code
;
xesc_func    db	 ?			;0 = sw-int, 1 = xesc
error_return dw	 ?			;address of error handler

which_func   dw   swi_txt,xli_txt	;will be indexed by xesc_func above
swi_txt	     db   'SW-INT',0
xli_txt      db   'XCALL',0     

;
; Error return values for software interrupt
;
SWI_ERR_ARGN_BAD_TYPE	equ  1 		; Bad argument passed to sw-int
SWI_ERR_VALUE_BAD_TYPE	equ  2 		; Bad type passed to sw-int
SWI_ERR_BIG_TO_32_BITS	equ  3 		; Number to large for sw-int

swi_errs  dw	swi_arg0,swi_arg1,swi_arg2

;
; Software Interrupt error messages
;
swi_arg0  db	  'Invalid argument to SW-INT',0
swi_arg1  db	  'Invalid return value for SW-INT',0
swi_arg2  db	  'Argument to SW-INT too large to fit in 32 bits',0

;
; Protected Mode Fatal type errors
;
cr_win	  db	  'CREATE WINDOW',0
al_seg	  db	  'ALLOCATE SEGMENT',0
dl_seg	  db	  'DELETE SEGMENT',0	  
rl_int	  db	  'ISSUE REAL INTERRUPT',0

;
; Gate to abort code in sc.asm
;


data	  ends


	  subttl  Progx code segment definitions
	  page

; external routines
	  extrn   alloc_fl:near,int2long:near,long2int:near,alloc_bl:near
	  extrn   getbase:near
	  extrn	  chg_vmode:near
	  extrn   pro_erro:near

progx	  segment para public 'PROGX'
	  assume  cs:xgroup,ds:dgroup,es:dgroup,ss:dgroup

	  extrn	  xcabt:far

	  public  init_rpc,xpcinit,xsetcrt,xresetcrt,xesc,load_all,unload_all
	  public  ssr
	  public  do_floarg,do_fixarg,do_bigarg,do_strarg
	  public  do_floval,do_intval,do_TFval,do_strval
	  public  softint,swi_strarg,swi_strval



	  subttl  RPC interface routines
	  page

; INIT_RPC
;  Load the real mode portion of scheme and save the handle in rpc_handle.
;  Then call the rpc routine to return the real address of a buffer which
;  will be used on subsequent rpc requests. This buffer is mapped to a
;  protected mode selector and stored in REAL_BUF_SELECTOR.
;
;  The transaction buffer for an rpc must be pointed to by DS:DX. Note that
;  we build this buffer up on the local stack.
;
init_rpc  proc	far
	  push	bp
	  sub	sp,80			;allocate transaction buffer
	  mov	bp,sp			;should be large enough for filename
	  cld
	  mov	  di,pcs_sysd		;di => system directory pathname
	  mov	  cx,64 		;cx =  max length
	  mov	  al,0
    repne scasb 			;scan pathname for eos character (=0)
	  jcxz	  ini_10		;jump if none
	  dec	  di			;di => end of pathname
ini_10:	  
	  mov	  cx,di
	  sub	  cx,pcs_sysd		;cx =  length of system directory 
 	  mov	  di,sp			;di => stack (transaction buffer)
	  mov	  si,pcs_sysd		;si => pcs-sysdir
      rep movsb 			;copy system directory into buffer
	  mov	  al,'\'                ;follow directory name with \
	  stosb
          mov	  si,offset rpc_real	
	  mov	  cx,rpc_real_len
      rep movsb 			;follow directory w/real proc filename

;Initialize real procedure call
	  mov	dx,sp			;ds:dx => real procedure filename
	  mov	ah,RPC_INIT		;load and init real procedure
	  int	DOS			;extended Dos call for Protected mode
	  jnc	ini_20			;continue if no error encountered

	  mov	ax, offset rpc_real	;ax => file that couldn't load
	  mov	cx,rpc_real_len		;cx => length of filename
	  jmp	fatal_file_err		;jump to fatal error handler
	  
ini_20:			
	  mov	rpc_handle,al		;save handle to real procedure
	  inc	rpc_loaded		;note real procedure loaded

; Obtain communication buffer for subsequent RPC calls
	  mov	dx,bp			;ds:dx => transaction buffer
	  mov	word ptr [bp],RPCRETBUF	;return real buffer opcode
	  mov	cx,8			;pass 8 bytes
	  mov	bx,cx			;expect 8 bytes returned
	  mov	ah,RPC			;issue Real Procedure Call
	  int	DOS			;extended Dos call for Protected mode
					;ignore return status

	  mov	dx,[bp]+2		;get length of buffer
	  sub	dx,2			;calc top of stack
	  mov	REAL_BUF_TOP,dx		; and save
	  mov	si,sp
	  add	si,4			;ds:si => real address of buffer
	  mov	ax,[si]+2		;get paragraph address
	  mov	REAL_BUF_PARA,ax	; and save
;ds:si=> offset,seg of real buffer, dx=length
	  call  map_real_mem		;map real address to protected selector
	  mov	REAL_BUF_SELECTOR,ax	; and save

	  add	sp,80			;now clean up the stack
	  pop	bp			 
	  ret				;and return
init_rpc  endp

; XPCINIT
;  Determine the machine type and perform machine specific initialization.
;  Call the real mode routine to perform initialization functions via the
;  RPC mechanism.
;
; Input:  none
; Output: return status, pc machine type, and video mode are returned
;         in the communications buffer accessed by REAL_MODE_SELECTOR.
;
xpcinit   proc 	far
	  push	RPCTYPE			; Type code
	  mov	dx,sp			; ds:dx => arg buffer
	  mov	cx,2 			; cx = # arg bytes passed
	  mov	bx,cx			; bx = # result bytes expected
	  mov	al,rpc_handle		; Handle to real mode part
	  mov	ah,RPC			; Real Procedure Call
	  int	DOS			; Extended Dos call for Protected mode
; Check for errors here
	  pop	ax			; ignore return status
; Get the return values from the real mode buffer
	  MOVE_ARGS_FROM_BUF <PC_MAKE,VID_MODE,CHAR_HGT>,REAL_MODE_BUFFER

	  mov	ax,ds
	  mov	es,ax			; restore extra seg reg
	  ret				; and return
xpcinit   endp


; XSETCRT
;  Take over the real mode crt interrupt handler during a dos-call so that
;  display will not be written to.
;
; Input:  none
; Output: screen output will be inhibited
;
xsetcrt   proc	  far
	  push	RPCTAKCRT		; Take over crt interrupt handler
	  mov	dx,sp			; ds:dx => arg buffer
	  mov	cx,2 			; cx = # arg bytes passed
	  mov	bx,cx			; bx = # result bytes expected
	  mov	al,rpc_handle		; Handle to real mode part
	  mov	ah,RPC			; Real Procedure Call
	  int	DOS			; Extended Dos call for Protected mode
	  pop	ax			; ignore return status
	  ret				; and return
xsetcrt   endp


; XRESETCRT
;  Restore the original crt interrupt handler after a dos call so that the
;  display can once again be written to.
;
; Input:  none
; Output: screen output will be restored
;
xresetcrt proc	  far
	  push	RPCRSTCRT		; Restore crt interrupt handler
	  mov	dx,sp			; ds:dx => arg buffer
	  mov	cx,2 			; cx = # arg bytes passed
	  mov	bx,cx			; bx = # result bytes expected
	  mov	al,rpc_handle		; Handle to real mode part
	  mov	ah,RPC			; Real Procedure Call
	  int	DOS			; Extended Dos call for Protected mode
; Check for errors here
	  pop	ax			; ignore return status
	  ret				; and return
xresetcrt endp



	  subttl  RPC interface routines to XLI
	  page

; LOAD_ALL
;  A portion of the XLI routines is in real mode and is communicated with 
;  via the Real Procedure Call (RPC). Data must be passed to the real mode
;  routine via the real buffer REAL_MODE_BUFFER
;
;  Any errors encountered are currently ignored.

l_save	  struc
exe_name  dw	?			;index to start of exe name
handle	  dw	?			;file handle
l_len	  db	?			;marker for size of local area
l_save	  ends

load_all  proc  far
	  push	bp
	  sub	sp,l_len		;allocate local storage
	  mov	bp,sp

; calc length of pathname
	  cld
	  mov	di,pcs_sysd
	  mov	cx,64 			;max length of pathname
	  mov	al,0
    repne scasb 			;look for eos character (=0)
	  jcxz	la_10			;jump if none
	  dec	di
la_10:
	  mov	cx,di
	  sub	cx,pcs_sysd		;cx = length of pcs-sysdir
; copy pcs-sysdir into transaction buffer
	  push	cx			;tempsave length
	  RESET_REAL_BUFFER_OFFSET	;ensure start at buffer start
	  MOVE_ARGS_TO_BUF <1>,REAL_MODE_BUFFER,autoincr  ;system file first
	  add	di,2			;save space for exe index
	  pop	cx			;restore length
	  mov	si,pcs_sysd		;ds:si addresses pcs-sysdir
	  MOVE_TO_REAL_BUF autoincr	;move to real memory buffer

	  mov	al,'\'                	;append \ onto pcs-sysdir name
	  MOVE_BYTE_TO_BUF al,,autoincr
;save index to exe filename
	  mov	[bp].exe_name,di	;save offset after pcs-sysdir
	  mov	bx,di			;save offset after pcs-sysdir
	  mov	di,2
	  MOVE_ARGS_TO_BUF <bx>         ;save index to exe file

	  mov	di,bx			;position offset for .EXE name
;save control filename to transaction buffer
	  mov	bx,ctl_file	   	;get address of ctl file
	  cmp	byte ptr [bx],'-'	;user override normal xli files?
	  jne	sysload			; no,  jump
	  mov	word ptr normal_files,0 ; Yes, don't load normal xli files
	  inc	ctl_file		;      bump ptr to name
sysload:
; load all system files - di should not be modified in following loop
	  mov	si,offset sys_files
loadfile:
	  push	si			;save offset into file table
	  mov	cx,ds:[si+2]		;cx =  length
	  mov	si,ds:[si]		;si => filename
	  MOVE_TO_REAL_BUF          	;copy filename to buffer
	  push	RPCLDEXE		;RPC request code to load EXE
	  mov	dx,sp			;ds:dx => rpc request code
	  mov	cx,2			;cx = # arg bytes passed
	  mov	bx,cx			;bx = # arg bytes returned
	  mov	al,rpc_handle		;al = handle
	  mov	ah,RPC			;Issue Real Procedure Call
	  int	DOS			;Issue extended dos funcall
	  pop	ax     			;ah = flags, al= return status
	  pop	si			;restore index into file table
	  sahf				;load flags
	  jnc	load_10			;no carry, proceed
	  mov	cx,ds:[si+2]		;cx =  length
	  mov	ax,ds:[si]		;si => filename
	  jmp	fatal_file_err  	;go report error
load_10:
	  add	si,4			;address next entry
	  cmp	word ptr ds:[si],0	;any more entrys?
	  jne	loadfile		; yes, loop
userload:
	  xor	di,di			;address system flag
	  MOVE_ARGS_TO_BUF <0>		;indicate user defined xli
	  mov	di,[bp].exe_name	;di = index to exe name
; open XLI control file
	  mov	  dx,ctl_file		;dx = address of filename
	  mov	  ax,FR_OPEN		;dos function - open file
	  int	  DOS
	  mov	  [bp].handle,ax	;save handle
	  jnc	  next_file		;jump if no open errors
	  jmp	  close1		;can't open file, exit
; read in next filename off the control file and append it to
; the pcs-sysdir name. 
next_file: 
	  mov	  di,[bp].exe_name	;es:di => buffer after pathname
	  mov	  bx,[bp].handle	;bx = file handle
next_char: 
	  push	  0   			;allocate place on stack
	  mov	  dx,sp			;dx = address of buffer
	  mov	  cx,1			;read one character
	  mov	  ax,FR_READ		;dos function - read file
	  int	  DOS			;ignore errors
	  pop	  dx			;retrieve character
	  jnc	  la_20 		;jump if no error, else
					;suddenly can't read control
					;file, close it and exit
close:	  
	  mov	  bx,[bp].handle	;bx = file handle
	  mov	  ax,FR_CLOSE		;dos functions - close file
	  int	  DOS			;ignore errors
close1:   
	  add	sp,l_len		;adjust stack	 
	  pop	bp
	  ret				;return

la_20:	  cmp	  ax,0			;at eof?
	  jz	  close 		;yes, jump
; we've read a character
	  cmp	  dl,0Dh		 ;carriage return?
	  je	  got_file		 ;yes, jump
	  cmp	  dl,' '     		 ;blank or control char?
	  jle	  next_char		 ;yes, skip it
	  MOVE_BYTE_TO_BUF dl,,autoincr  ;move character to buffer
	  jmp	  next_char
; we've read a complete filename, go load it
got_file: 
	  MOVE_BYTE_TO_BUF 0		;form ASCZII string

	  push	RPCLDEXE		;RPC request code to load EXE
	  mov	dx,sp			;ds:dx => rpc buffer
	  mov	cx,2			;cx = # arg bytes passed
	  mov	bx,cx			;bx = # arg bytes returned
	  mov	al,rpc_handle		;al = handle
	  mov	ah,RPC			;Issue Real Procedure Call
	  int	DOS			;Issue extended dos funcall
	  pop	ax			;bump result arg from stack
	  sahf				;ah = flags
	  jnc	  next_file		;jump if no errors
	  xor	  ah,ah			;clear flags from result
	  cmp	  ax,0			;any open slots?
	  je	  close 		;no, jump
	  cmp	  ax,2			;file found?
	  je	  next_file		;no, jump
	  cmp	  ax,8			;ran out of memory?
	  jne	  next_file		;no, jump; ignorable error
	  jmp	  close 		;yes
load_all  endp


; UNLOAD_ALL
;  Call the real mode routine to unload all exe files.
; 
; Upon exit:
;    All previously bid xli programs will be released from real memory.
;
unload_all proc far
	  push  RPCUNLDALL		; RPC request code to unload all exe's
	  mov	dx,sp              	; ds:dx => arg buffer
	  mov	cx,2			; cx = # arg bytes passed
	  mov	bx,2			; bx = # result bytes expected
	  mov	al,rpc_handle		; Handle to real mode part
	  mov	ah,RPC			; Real Procedure Call
	  int	DOS			; Extended Dos call for Protected mode
	  pop	ax			; ignore errors
	  ret
unload_all endp

; FATAL_FILE_ERR
;   We are unable to load a system file in real mode, and cannot
;   continue with scheme. The routine XCABT (in sc.asm) will output
;   a message (via DOS function 9) to the console and abort. Our
;   io may not be available at the time of this error.
;
; On entry:
;   ax => filename we are trying to load
;   cx =  length of filename
;
	  public fatal_file_err
fat_err	  proc  near
fatal_file_err  label near
	  mov	bx,ss
	  mov	ds,bx
	  mov	es,bx				;ds,es,ss = data segment
	  mov	si,ax				;ds:si addresses filename
	  mov	di,offset FILNAM		;es:di addresses message
	  rep   movsb				;move filename into message
	  mov	byte ptr es:[di],"$"		;terminate byte
	  cmp	rpc_loaded,0		        ;have we gotten past rpc load?
	  je	fat_exit    		        ; no,  exit
	  call	unload_all 			; yes, ensure all xli's unloaded
fat_exit:
	  mov	dx,offset FILERR		;ds:dx => message
	  jmp	pgroup:xcabt			;exit to DOS
fat_err  endp

; FATAL_PRO_ERR
;   A protected mode operation has failed. Call pro_error in serror.c to
;   output an error message and attempt a scheme-reset.
;   a scheme reset.
;
; On entry:
;   ax =  error number
;   bx => function call name
;   cx => operation being performed (sw-int, xcall, etc.)
;
pro_err	  proc  near
fatal_pro_err  label near
	  push	  bp
	  mov	  bp,sp  			;set up stack for call
	  push	  ss
	  pop	  ds				;ensure ds = data segment
	  push    ax				;error number
	  push	  bx				;function call
	  push	  cx				;routine
	  mov	  C_fn, offset pgroup:pro_erro
	  call	  far ptr far_C		        ;control will not return here
pro_err   endp


; XESC				 
;   Handler for the "%xesc" opcode.
;
; On entry:
;   AX = length of xesc call (= inst length - 1)
;   ES:SI = pointer to bytecode arguments of the %xesc opcode
;
; On exit:
;   normal: the VM reg that contained the name string on entry will
;	    contain the page:offset of the return value; there may
;	    be side effects in strings that were arguments to %xesc
;	    BX = 0 (no errors)
;   error:  BX = error#
;
; Description:
;   A buffer is built for an RPC call to the real mode handler for
;   an external subroutine call (XCALL). The buffer is built in a  
;   buffer in the real mode routine as follows:
;
;   +----------------------------------------+
;   |  Routine name length         (1 word)  |
;   |  Routine name          (above length)  |
;   |					     |
;   |  Number of XCALL Arguments   (1 word)  |
;   |					     |
;   |  Type of Arg1		   (1 word)  |
;   |  Arg1		   (type dependent)  |
;   |      .				     |
;   |      .				     |
;   |      .				     |
;   |  Type of Argn	           (1 word)  |
;   |  Argn		   (type dependent)  |
;   +----------------------------------------+
;
;   After calling the real mode handler, the buffer will contain
;   result info and return values. See the structure "xesc_result"
;   for a description of the buffer upon return.
;

;
; This following data will be allocated locally within xesc
;
local_save struc			
; following is used to store return data from xli routines
xesc_status dw ?		; return status
xesc_vtype  dw ?		; type of value being returned
xesc_value  dw 4 dup (?)	; return value
; following is local data used in building xli call
saved_si    dw ?		; segment offset of vm bytecode
saved_es    dw ?		; segment address of vm bytecode
first_arg   dw ?		; first actual argument
arg_count   dw ?		; number of args (len,name are not args)
rvreg       dw ?		; vm register to hold return value
local_save  ends

arg_ptr	    equ	  saved_si	; alias for current argument pointer
ssr_status  equ   xesc_status	; ssr return status (will be -1)
ssr_argnum  equ   xesc_vtype	; argument requested (zero based) by ssr
ssr_len	    equ   xesc_value	; length requested
ssr_offset  equ   xesc_value+2	; real mode offset to store arg
ssr_seg     equ   xesc_value+4	; real mode segment to store arg
result_buf_len equ saved_si-xesc_status ; length of result buffer


xesc	  proc	  far			
       	  push	  bp 				;save callers bp
	  sub	  sp,rvreg+2			;reserve for local storage
	  mov	  rpc_saved_sp,sp		;save off stack pointer
	  mov	  bp,sp				; and update BP
							       
	  mov	  xesc_func,1
	  lea	  bx,xesc_err_exit		; Set up error handler for xesc
	  mov	  error_return,bx

	  mov	  [bp].saved_es,es		;save segaddr of arguments
	  inc	  si				;bump past name to first arg
	  mov	  [bp].saved_si,si		; and save
	  mov	  [bp].first_arg,si
	  dec	  si

	  sub	  ax,2				;calc # args (not incl. name)
	  mov	  [bp].arg_count,ax		; and save

	  RESET_REAL_BUFFER_OFFSET    		;ensure start at zero

;
; Move the string name to the real mode buffer
;
	  xor	  bh,bh
	  mov 	  bl,byte ptr es:[si]		;BX is reg# of name string
	  lea	  bx,regs[bx]			;VM reg @
	  mov	  [bp].rvreg,bx 		;  save as return register
	  mov	  si,[bx].C_page
	  cmp	  ptype[si],STRTYPE*2		;is it a string?
	  je	  xesc_15			;yes, jump
	  cmp	  ptype[si],SYMTYPE*2		;is it a symbol?
	  je	  xesc_10			;yes, jump
	  mov	  ax,XLI_ERR_NAME_BAD_TYPE	;error: name not string, symbol
	  jmp	  xesc_err_exit
;
; Warning : DS is not used for the local data segment in the following code
;
xesc_10:  
	  %LoadPage ds,si			;page# in SI -> para# in DS
	  mov	  si,ss:[bx].C_disp		;DS:SI is symbol object @
	  mov	  cx,[si].sym_len		;get symbol object length
	  sub	  cx,sym_ovhd			;subtract symbol's overhead
	  add	  si,sym_ovhd			;skip past overhead
	  jmp	  short xesc_25
xesc_15:  %LoadPage ds,si			;page# in SI -> para# in DS
	  mov	  si,ss:[bx].C_disp		;DS:DI is string object @
	  mov	  cx,[si].str_len		;get string object length
	  cmp	  cx,0				;is it positive?
	  jge	  xesc_20			;yes, jump; normal string
	  add	  cx,str_ovhd*2 		;no, assume short string
						;rather than really long string
						;and make positive
xesc_20:  sub	  cx,str_ovhd			;subtract string's overhead
	  add	  si,str_ovhd			;skip past overhead
xesc_25:  
	  push	  ds
	  push	  si				;temp save string ptr
	  push	  cx				;and length

	  mov	  ax,ss				;get local data seg
	  mov	  ds,ax

	  MOVE_ARGS_TO_BUF cx,REAL_MODE_BUFFER,autoincr  ;move length to buf

	  pop	  cx
	  pop	  si				
	  pop	  ds				;ds:si => string ptr
	  
	  MOVE_TO_REAL_BUF autoincr		;move string to buf

;
; Warning : DS is not used for the local data segment in the above code
;
	  mov	  ax,ss
	  mov	  ds,ax				;restore data segment
;
; Move argument count to real mode buffer
;	 
	  mov	  bx,[bp].arg_count
	  MOVE_ARGS_TO_BUF bx,,autoincr,save   	;move #args to buffer

;
; Move the xesc arguments to the real mode buffer.
;
	  cmp	  bx,0	    			;any arguments?
	  je	  xloop_done			; no, jump
xesc_loop:
	  les	  si,dword ptr [bp].arg_ptr     ;es:si => argument
	  inc	  [bp].saved_si			;bump for next time thru
	  xor	  bh,bh
	  mov     bl,byte ptr es:[si]		;pick up arg
	  lea	  bx,regs[bx]			;BX is VM reg @
	  mov	  si,[bx].C_page		;get its page#
	  mov	  si,ptype[si]		        ; and type
	  push	  si				;save around following
;move type info to buffer
	  MOVE_ARGS_TO_BUF si,REAL_MODE_BUFFER,autoincr
; Dispatch on argument type
	  pop	  si				;restore type #
	  call	  cs:word ptr do_arg[si]	;process argument (by type)
	  dec	  [bp].arg_count	        ;any more args left
	  jnz	  xesc_loop			; yes, loop
xloop_done:
	  RESET_REAL_BUFFER_OFFSET		;reset buffer ptr for later
;
; Now issue the RPC call, real routine knows where the buffer is
;
	  push	  0				 ;dummy word
	  push	  RPCXESC        		 ;RPC REQUEST CODE
xesc_57:
	  mov	  dx,sp				 ;DS:DX = transaction buffer
	  mov     cx,4
	  mov	  bx,cx				 ;DX = length of result
	  mov	  al,rpc_handle			 
	  mov	  ah,RPC			 ;Issue RPC
	  int	  DOS				 ;Extended Dos func
	  pop	  ax				 ;get return status
	  mov     sp,bp			 	 ;dump args off stack
	  or 	  ax,ax				 ;error during xesc call?
	  je	  normal			 ;  no, continue
	  cmp	  ax,XLI_ERR_NO_SUCH_NAME	 ;calling an unknown xli func?
	  jne	  xesc_null_err_exit		 ;  no, return error
	  mov	  bx,[bp].rvreg			 ;load bx with name requested
	  jmp	  xesc_err_exit		 	 ;and return with error
		
; We're back with a return value--unless it's a special service call.
; At this point, ES:DI should point to buffer.
normal:   cld

	  mov	  si,sp				;store data on stack (ds:si)
	  les	  di,dword ptr REAL_MODE_BUFFER	;address real buffer (es:di)
	  mov	  cx,result_buf_len		;cx = length
	  MOVE_FROM_REAL_BUF			;move return data to local stack

	  mov	  ax,[bp].xesc_status		;get return status
	  or	  ax,ax				;Check status
	  jl	  ssr				; <0 = SSR	
	          				;  0 = normal return
	  mov	  di,[bp].xesc_vtype		;get return value type
	  cmp	  di,N_RV*2			;out of range?
	  jb	  xesc_70			; no,  jump
	  cmp	  di,RV_ERR*2			;xli program error?
	  jne	  xesc_65			; no,  jump
	  mov	  si,bp				;
	  add	  si,xesc_value			;DS:SI => return value
	  mov	  bx,[bp].rvreg			;bx = return reg address
	  call	  do_strval			;go get the error message
	  mov	  ax,XLI_ERR_EXTERNAL_ERROR	;ax=error indication
	  mov	  bx,[bp].rvreg			;bx = return reg address
	  jmp	  xesc_err_exit			;bx=message
xesc_65:
	  mov	  ax,XLI_ERR_VALUE_BAD_TYPE     ;unkown return type
	  jmp	  xesc_null_err_exit		;return error
xesc_70:  
	  mov	  si,bp
	  add	  si,xesc_value			;DS:SI => return value
	  mov	  bx,[bp].rvreg			;bx = return reg address
	  call	  cs:word ptr do_val[di]	;process return value
	  mov	  ax,0				;AX=0 says no errors

xesc_null_err_exit:
	  lea	  bx,nil_reg			;"nil irritant" for some errors
; ax = error indicator (0 = no error), bx=irritant
xesc_err_exit label near
	  mov	  cx,mem_entry			;any entries in mem_table?
	  jcxz	  xesc_ex10			;no, jump
	  push	  ax				;tempsave error indicators
	  push	  bx
	  xor	  bx,bx
	  mov	  mem_entry,bx			;see if any real mode segments
xesc_ex05:
	  mov	  es,mem_table[bx]		;get entry in mem_table
	  mov	  ax,DELETE_SEG			;delete the real mode segment
	  int	  dos
	  jnc	  xesc_ex07
	  mov	  bx,offset dl_seg
	  mov	  cx,offset xli_txt
	  jmp	  fatal_pro_err			;control will not return here
xesc_ex07:
	  inc	  bx
	  inc 	  bx				;address next entry
	  loop	  xesc_ex05			;go release next one
	  pop	  bx				;restore error indicators
	  pop	  ax
; at this point, ax = error number, bx = irritant (if error)
xesc_ex10:
	  mov	  sp,rpc_saved_sp		;clean up stack
	  add	  sp,rvreg+2	  
	  pop	  bp				;restore callers bp
	  ret	    				;return
; SSR
;  A real procedure has issued a System Service Request (SSR). Currently,
;  this means to pass a string to the real procedure. The result buffer
;  indicates the argument from the %xesc call requested (0 based), the
;  length of the string, and the real mode segment/offset to place the
;  string. This routine copies the data into the real routine's address
;  space, and returns.
;

ssr	  label	  near
	  mov	  si,[bp].first_arg		 ;arg list pointer
	  add	  si,[bp].ssr_argnum		 ;now address arg desired
	  mov	  es,[bp].saved_es		 ;ES:SI addresses the arg
	  mov	  bl,byte ptr es:[si]		 ;get reg #
	  xor	  bh,bh
	  lea	  bx,regs[bx]			 ;BX is reg@

	  mov	  si,[bx].C_disp		 ;si = string object offset
	  mov	  bx,[bx].C_page		 ;bx = string object page #
	  %LoadPage es,bx			 ;es:si => string object
	  inc	  si				 ;skip over tag
	  cld
	  lods    word ptr es:[si]		 ;get string's length
	  cmp	  ax,0				 ;a short string?
	  jge	  ss_5				 ;no, jump
	  add	  ax,str_ovhd*2 		 ;yes
ss_5:	  sub	  ax,str_ovhd			 ;subtract off overhead
;
; es:si => string, ax = length
;
	  mov	  dx,[bp].ssr_len		 ;get length of dest string
	  or	  dx,dx				 ;if non-zero
	  jnz	  ss_10				 ;  then jump
;
; A length of zero indicates that the xli routine wants to address far
; strings. Allocate real memory and put the real segment address into
; the transaction buffer. PRO2REAL will move the string to real memory.
; The real memory selector is saved in mem_table, and released when we 
; exit this xesc call.
;
	  push	  ax			;save length
	  push	  si
	  push	  es			;save ptr to string
	  xor	  cx,cx			
	  mov	  dx,ax			;cx:dx = string length
	  mov	  ax,ALLOC_REAL		;Allocate real segment
	  int	  dos			;Allocate real segment
	  jnc	  ss_07
	  mov	  bx,offset al_seg
	  mov	  cx,offset xli_txt
	  jmp	  fatal_pro_err		;control will not return here
ss_07:
; ax=selector, bx=para address
	  push	  ax			;tempsave selector					      
	  les	  di,dword ptr REAL_MODE_BUFFER
	  add	  di,ssr_seg		;address of real buffer (es:di)
	  MOVE_ARGS_TO_BUF bx		;save segment to real mode
	  mov     dx,cx			;dx = length
	  pop	  ax			;restore selector
; save real memory selector in table
	  mov	  bx,mem_entry		;get entry number
	  inc	  mem_entry		;bump number of entries
	  shl	  bx,1			;index into memory table
	  mov	  mem_table[bx],ax	;save selector there

	  pop	  es
	  pop	  di			;es:di => string to copy
	  pop	  dx			;restore length
	  jmp	  ss_25
; We have a string length here, set ds:si to point to the real memory
; address. PRO2REAL will create a real window over this area, and copy
; the string to it.
ss_10:
	  cmp	  ax,dx 		;string len >= buffer len?
	  jae	  ss_20 		;yes, jump
	  mov	  dx,ax 		;dx = #chars to copy
ss_20:					
      	  mov	  di,si			;es:di = string to copy
	  mov	  si,bp
	  add	  si,ssr_offset		;ds:si => real memory address
	  xor	  ax,ax			;use ds:si to map address
ss_25:
	  call	  pro2real		;copy to real memory

	  push	  cx
	  push	  RPCXLISSR
	  jmp	  xesc_57
		     
xesc	  endp


; SOFTINT
;   Handler for the "software interrupt"
;
; Use:
;   call SOFTINT    7,op,intnum,return-type,ax,bx,cx,dx
;   where all arguments are pcs registers
;
; On exit:
;   The first register will contain the returned value
;
; Description:
;   All args are interrogated to determine the length of a buffer
;   required to hold the args. A buffer is allocated in real mode
;   (via function E8), the args are then copied into the buffer,
;   and the software interrupt is issued. Upon return, the return
;   value is processed, the buffer is deallocated, and the first
;   register is set with the return value.

;
; This following data will be allocated locally within SWINT
;
local_save struc
; Following is the machine state block for Issue Real Interrupt request
msb_ax	   dw ?			; ax register for interrupt
msb_bx	   dw ?			; bx register for interrupt
msb_cx	   dw ?			; cx register for interrupt
msb_dx	   dw ?			; dx register for interrupt
msb_si	   dw ?			; si register for interrupt
msb_di	   dw ?			; di register for interrupt
msb_flags  dw ?			; flags register for interrupt
msb_ds	   dw ?			; ds register for interrupt
msb_es	   dw ?			; es register for interrupt
; The following local data contains ptrs into the real segment
selector   dw ?			; selector for real segment
buf_ptr	   dw ?			; local pointer into real segment
msb_ptr	   dw ?			; local pointer into msb
stop	   dw ?			; temp data
work_spc   dd ?			; temp working storage
; Following definitions define the stack upon call
caller_bp  dw ?			; callers bp
farret	   dd ?			; far return address
dummy	   dw ?			; %esc first arg = # operands
arg4       dw ?			; arg4 = dx
arg3       dw ?			; arg4 = cx
arg2       dw ?			; arg4 = bx
arg1       dw ?			; arg4 = ax
ret_type   dw ?			; return type
intnum     dw ?			; interrupt number
op	   dw ?			; op-code
local_save ends

softint	  proc	  far
       	  push	  bp 				;save callers bp
	  sub	  sp,caller_bp			;allocate local storage
	  mov	  bp,sp				;and update BP

	  and	  xesc_func,0			;note sw-int 
	  lea	  bx,swi_err_exit		;error handler for sw-int
	  mov	  error_return,bx

; Sum up the space required to hold all the arguments

	  mov	  si,bp
	  add	  si,arg4-2			;SI => args
	  mov	  [bp].stop,si			;save for later
	  mov	  di,bp
	  add	  di,msb_dx			;DI => regs in msb
	  mov	  cx,4				;CX = number of args
	  xor	  dx,dx				;DX = space required
sum_spc:
	  push	  di				;temp save di
	  add	  si,2				;address arg
	  mov	  bx,[si]			;get vm reg
	  mov	  di,[bx].C_page		;get its page#
	  cmp	  ptype[di],STRTYPE*2		;Is it a string?
	  jne	  sum_010			; no,  jump
	  %LoadPage es,di			; yes, 
	  mov	  di,[bx].C_disp		;    es:di => string
	  inc	  di				;    skip tag	
	  mov	  ax,es:[di]        		;    get string object length
	  cmp	  ax,0				;    is it positive?
	  jge	  sum_005			;     yes, jump; normal string
	  add	  ax,str_ovhd*2 		;     no,  short string
sum_005:  sub	  ax,str_ovhd			;          subtract overhead
	  inc	  ax  				;          add 1 for null terminator
	  jmp	  short sum_020
sum_010:
	  mov	  ax,4				;non-string at least 4 bytes
	  cmp	  ptype[di],FLOTYPE*2		;floating point object?
	  jne	  sum_020			; no,  jump
	  add	  ax,4				; yes, floats are 8 bytes
sum_020:  
	  pop	  di				;msb register ptr
	  mov	  ds:[di],ax			; save length of object
	  sub	  di,2				; next msb register ptr
	  add	  dx,ax				;sum space required	
	  loop	  sum_spc			;and loop

; CX:DX = space required to buffer the args, SI => arg 1 at this point

	  mov	  ax,ALLOC_REAL			;Create real segment
	  int	  DOS				;Extended Dos Function request
	  jnc	  swi_07
	  mov	  bx,offset al_seg
	  mov	  cx,offset swi_txt
	  jmp	  fatal_pro_err			;control will not return here
swi_07:
	  mov	  [bp].selector,ax		;save segment selector
	  mov	  es,ax				;es = real buffer selector
	  mov	  [bp].msb_ds,bx		;save para address in msb
	  mov	  [bp].msb_es,bx		;save para address in msb
	  mov	  [bp].buf_ptr,0		;pointer within real segment
	  mov	  [bp].msb_ptr,bp		;pointer into msb regs

; Move each arg into the buffer, SI => arg1 at this point
;
swi_020:
	  cmp	  si,[bp].stop			;all args processed?
	  je	  swi_025			;  yes, jump

	  std
	  lods	  word ptr [si]			;pick up arg
	  mov	  bx,ax				;save in BX

	  mov	  di,[bp].msb_ptr		;di = ptr to reg in msb
	  add	  [bp].msb_ptr,2		;      set for next time
	  mov	  cx,ds:[di]			;cx = length of object
	  mov	  ax,[bp].buf_ptr		;ax = ptr into buffer
	  add	  [bp].buf_ptr,cx		;      set for next time
	  mov	  ds:[di],ax			;update msb reg with buf ptr
	  mov	  di,ax				;es:di => buffer

; Dispatch on argument type
	  push	  si				;tempsave arg ptr
	  mov	  si,[bx].C_page		;get page#
	  mov	  si,ptype[si]			;  and type
; BX=page #, CX=length, ES:DI=>buffer
	  call	  cs:word ptr do_arg[si]	;Handle each object.
	  pop	  si				;restore arg ptr
	  jmp	  swi_020 

; At this time all args are in the buffer, Issue the sofware interrupt

swi_025:
	  cld
	  mov	  bx,[bp].intnum		;get reg holding int
	  mov	  ax,[bx].C_disp		;AL = interrupt number
	  mov	  dx,bp				;DS:DX => machine state block 
	  mov	  bx,msb_es+2			;# bytes which may change
	  mov	  ah,REAL_INTRP			;AH = Issue Real Interrupt
	  int	  DOS				;Extended Dos Function Request
	  jnc	  swi_27
	  mov	  bx,offset rl_int
	  mov	  cx,offset swi_txt
	  jmp	  fatal_pro_err			;control will not return here
swi_27:
; We're back from software interrupt, lets get return value

	  mov	  bx,[bp].ret_type		;get vm reg
	  mov	  di,[bx].C_disp
	  shl	  di,1				;make index into valu table
	  cmp	  di,N_RV*2			;return value out of range?
	  jb 	  swi_070
	          				;bx = reg holding return type 
	  mov	  ax,SWI_ERR_VALUE_BAD_TYPE	;ax = error indicator
	  jmp	  swi_err_exit
swi_070:
; now go convert the return values
	  mov	  si,bp				;ds:si => address of ret value
	  mov	  bx,[bp].op			;bx = return register
	  call	  cs:word ptr do_val[di]	;handle one type of return value
	  mov	  ax,0				;AX=0 says no errors
; ax= error indicator (if nonzero, bx = irritant)
swi_err_exit label near
	  push	  ax				 ;push error number
	  push	  bx				 ;push irritant
	  mov	  es,[bp].selector
	  mov	  ax,DELETE_SEG			 ;Delete Real Segment
	  int	  DOS				 ;Extended Dos Function
	  jnc	  swi_077
	  mov	  bx,offset dl_seg
	  mov	  cx,offset swi_txt
	  jmp	  fatal_pro_err		;control will not return here
swi_077:
	  pop	  cx				 ;cx = irritant
	  pop	  ax				 ;ax = error indication
	  mov	  bx,ax				 ; move to bx
	  dec	  bx				 ; form index
	  js	  swi_ret			 ;negative - no error
	  shl	  bx,1				 ;form index
	  mov	  bx,swi_errs[bx]		 ;bx => error message
	  mov	  ax,1				 ;note non-restartable
; ax= error indicator (if nonzero bx=message address, cx = irritant)
swi_ret:
	  mov	  sp,bp
	  add	  sp,caller_bp
	  pop	  bp
	  ret
softint	  endp


	  subttl  Code segment:  Copy arguments to xfer buffer
	  page


;; Jump tables to handle arguments to the %xesc call
; indexed by argument type (standard PCS type tag)
do_arg	  dw	  do_lstarg			 ;0=list (#f only)
	  dw	  do_fixarg			 ;1=fixnum
	  dw	  do_floarg			 ;2=flonum
	  dw	  do_bigarg			 ;3=bignum
	  dw	  do_symarg			 ;4=symbol (#t only)
	  dw	  do_strarg			 ;5=string
	  dw	  do_errarg			 ;6 the rest we don't care about
	  dw	  do_errarg			 ;7
	  dw	  do_errarg			 ;8
	  dw	  do_errarg			 ;9
	  dw	  do_errarg			 ;10
	  dw	  do_errarg			 ;11
	  dw	  do_errarg			 ;12
	  dw	  do_errarg			 ;13
	  dw	  do_errarg			 ;14
	  dw	  do_errarg			 ;15

; On entry to all the argument handler routines:
;   ES:DI = pointer to real mode buffer to store data
;   BX = address of VM reg with page:offset of Scheme object
;   SI = Type of operand code
;
; On exit:
;   CX = number of bytes moved to the buffer pointed to by ES:DI

;
; Process list argument
;
do_lstarg label   near				;looking for false only
	  cmp	  [bx].C_page,NIL_PAGE*2
	  je	  do_lst01
	  jmp	  do_errarg
do_lst01:
	  xor	  ax,ax
	  jmp	  do_log

;
; Process fixnum argument
;
do_fixarg label   near
	  mov	  ax,[bx].C_disp		;get the fixnum data
	  shl	  ax,1				;deal with sign bit
	  sar	  ax,1				;ax = 16-bit signed int
; True and false are treated as the numbers 1 and 0, respectively.
; Boolean-argument processing merges into integer processing at this point.
do_log:   cwd					;dx:ax is 32-bit signed int
	  MOVE_ARGS_TO_BUF <dx,ax>,,autoincr,save
	  ret					;and return
;
; Process float argument
;
do_floarg label	  near
	  push	  ds				;preserve data seg

	  mov	  si,[bx].C_page		;get float's page #
	  mov	  ax,[bx].C_disp		; and offset
	  %LoadPage ds,si
	  mov	  si,ax				;ds:si => float
	  inc	  si				;bump past header
	  mov	  cx,8				;cx = length of float
	  MOVE_TO_REAL_BUF autoincr,save	;move float to buffer
	  pop	  ds				;restore data seg
	  ret					;and return

;
; Process bignum argument
;
do_bigarg label	  near
; Stage the conversion to longint on the stack
	  sub	  sp,4				;allocate stack space for long
	  mov	  ax,sp				;note its address
; ok to add to stack here because we've reserved space above.
	  push	  es				;save regs around call
	  push	  di
	  push	  bp 
	  mov	  bp,sp
	  push	  bx				;push VM reg@
	  push	  ax                   		;push buffer@
	  mov	  C_fn,offset pgroup:int2long   ;convert bignum to long
	  call	  far ptr far_C
	  pop	  bx				;dump buffer@
	  pop	  bx				;restore VM reg@
	  pop	  bp				;restore bp
	  pop	  di				;        di
	  pop	  es				;	 es
; above cleans stack up from calling C routine
	  cmp	  ax,0				;did bignum convert OK?
	  je	  do_big5			;yes, jump
; there was an error in converting the number
	  mov	  ax,XLI_ERR_BIG_TO_32_BITS	;ax = error # (default xli)
	  cmp	  xesc_func,0			;performing xli function?
	  jne	  do_bigerr			; yes, jump
	  mov	  ax,SWI_ERR_BIG_TO_32_BITS	;ax = error # (for sw-int)
; ax=error number, bx=irritant
do_bigerr:
	  jmp	  error_return
do_big5:
	  mov	  si,sp				;ds:si => long int
	  mov	  cx,8				;cx = length
	  MOVE_TO_REAL_BUF autoincr,save	;move float to buffer
	  add	  sp,4				;clean up stack
	  ret					;and return

;
; Process symbol argument
;
do_symarg label	  near				;looking for true only
	  cmp	  [bx].C_page,T_PAGE*2
	  jne	  do_errarg
	  cmp	  [bx].C_disp,T_DISP
	  jne	  do_errarg
	  mov	  ax,1
	  jmp	  do_log

;
; Process string arguments
;
do_strarg label	  near
	  or	  xesc_func,0			;doing xesc?
	  jz	  swi_strarg			; no,  jump
	  MOVE_ARGS_TO_BUF <-1>,,autoincr,save	; yes, indicate string
	  ret
swi_strarg:					;move string to swint buffer
	  push	  ds				;preserve regs
	  push	  si
	  mov	  ax,[bx].C_disp		;get offset
	  mov	  si,[bx].C_page		;get page #
	  %LoadPage ds,si
	  mov	  si,ax				;ds:si => string
	  inc	  si				;skip tag
	  cld
	  lods	  word ptr [si]			;get length
	  or 	  ax,ax				;is it positive?
	  jge	  swi_str05			;yes, jump; normal string
	  add	  ax,str_ovhd*2 		;no,  short string
swi_str05:
	  sub	  ax,str_ovhd			;subtract overhead
	  mov	  cx,ax				;CX = length of string
	  MOVE_TO_REAL_BUF autoincr    		;move string across
	  mov	  ax,ss
	  mov	  ds,ax
	  push	  cx				;save # bytes just written	  
	  MOVE_BYTE_TO_BUF 0,,autoincr		;write out null terminator
	  pop	  cx
	  inc	  cx				;cx = total # bytes written
	  pop	  si				;restore preserved regs
	  pop	  ds
	  ret

do_errarg label   near
	  mov	  ax,XLI_ERR_ARGN_BAD_TYPE      ;ax = error # (default xli)
	  cmp	  xesc_func,0			;performing xli function?
	  jne	  do_errerr			; yes, jump
	  mov	  ax,SWI_ERR_ARGN_BAD_TYPE	;ax = error # (for sw-int)
; ax = error number, bx=irritant
do_errerr:
	  jmp	  error_return


	  subttl  Code segment:  Copy return value back into Scheme
	  page

;; Jump tables to handle values returned from the real routine
; indexed by value type (SW-INT return types)
do_val	  dw	  do_intval			 ;0=integer
	  dw	  do_TFval			 ;1=true/false
	  dw	  do_strval			 ;2=string
	  dw	  do_floval			 ;3=flonum


; On entry to all the value handler routines:
;	  BX    = result register address
;	  DS:SI = pointer to return value

;
; Process integer return value
;
do_intval proc	  near
do_int10: 
	  push	  bp
          mov	  bp,sp 			;get BP set for C call
	  or	  xesc_func,0			;doing xesc?
	  jnz	  doint_05			; yes, jump
	  push	  [si]				;si=> msb_ax on stack. remember
	  push	  [si]+2	  		;lattice's return conventions
	  jmp	  doint_07
doint_05: push	  [si]+2			;push longint
	  push	  [si]
doint_07: push	  bx				;push vm reg address
	  mov	  C_fn,offset pgroup:long2int	;allocate integer
	  call	  far ptr far_C 		;C longint -> PCS integer
						;(bignum or fixnum)
	  mov	  sp,bp 			;pop C args
	  pop	  bp				;restore callers bp
	  ret					; and return
do_intval endp

;
; Process true/false return value
;
do_TFval  proc	  near
	  mov	  cx,0
	  or	  xesc_func,0			 ;doing xesc?
	  jnz	  dotf_05			 ; yes, jump
	  mov	  ax,[si]+2			 ;si=> msb_ax on stack. remember
	  jmp	  dotf_07			 ;lattice's return convention
dotf_05:  mov	  ax,[si]			 ;get value
dotf_07:  or	  ax,ax				 ;zero?
	  jz	  do_TF10			 ; yes (false object)
	  mov	  ax,T_DISP			 ; no  (true object)
	  mov	  cx,T_PAGE*2
do_TF10:
	  mov	  [bx].C_disp,ax
	  mov	  [bx].C_page,cx
	  ret
do_TFval  endp

;
; Process float return value
;
do_floval proc	  near
	  push	  bp
	  mov	  bp,sp
	  or	  xesc_func,0			;doing xesc?
	  jnz	  doflo_05			; yes, jump
	  push	  [si]				;si=> msb_ax on stack. remember
	  push	  [si]+2	  		;lattice's return conventions
	  push	  [si]+4	  		;and push args appropriately.
	  push	  [si]+6
	  jmp	  doflo_07
doflo_05: push	  [si]+6			;push float values
	  push	  [si]+4
	  push	  [si]+2
	  push	  [si]
doflo_07: push	  bx				;push vm return reg
	  mov	  C_fn,offset pgroup:alloc_fl	;allocate float
	  call	  far ptr far_C 		;C double -> PCS flonum
	  mov	  sp,bp 			;pop args from stack
	  pop	  bp
	  ret
do_floval endp

;
; Process string return values
;
do_strval proc	  near
	  or	  xesc_func,0			;doing xesc?
	  jz	  swi_strval			; no,  jump
;
; Do it for xli
;
	  push	  bp
	  mov	  bp,sp

	  mov	  cx,[si]           		;get string length
	  cmp	  cx,16380			;string length short enough?
	  jbe	  do_stv15			;yes, jump
	  mov	  cx,16380 			;no, truncate at max
do_stv15: 
; allocate the space for the return value string object
	  push	  cx				;save length for later
	  push	  si				;     pointer to buffer
	  push	  bx				;     return value VM reg
	  push	  bp
	  mov	  bp,sp 			;get BP set for C call
	  push	  cx				;push length
	  push	  STRTYPE			;push type
	  push	  bx				;push return value VM reg @
	  mov	  C_fn,offset pgroup:alloc_bl   ;allocate block
	  call	  far ptr far_C 		;go do it
	  mov	  sp,bp 			;pop C args
	  pop	  bp
	  pop	  bx				;return VM reg
	  mov	  di,[bx].C_disp
	  mov	  bx,[bx].C_page
	  %LoadPage es,bx
	  add	  di,3				;es:si => destination
	  pop	  si
	  add	  si,2				;ds:si => real mode address
	  pop	  dx				;dx = length
	  call	  real2pro			;xfer from real mem to pro mem
	  mov	  sp,bp				;clean up stack
	  pop	  bp				;restore caller's bp
	  ret					;and return
;
; Do it for software interrupt
;
swi_strval:
	
	  push	  ds				;tempsave ds
	  mov	  si,[bp].msb_ax
	  mov	  ds,[bp].selector		;DS:SI points to string

	  push	  ss
	  pop	  es
	  mov	  di,bp	
	  add	  di,work_spc			;ES:DI => destination

	  mov	  ax,BLOCK_XFER			;grab one byte and test zero
	  mov	  cx,1
	  mov	  dx,0FFFFh
swi_str01:
	  inc	  dx				;# bytes read
	  int	  DOS				;xfer 1 byte
	  inc	  si				;next byte to read
	  cmp	  byte ptr es:[di],0		;is it zero?
	  jne	  swi_str01			;no, get next char
swi_stv15:
	  pop	  ds				;restore ds
	  push	  dx				;save length for later
;
; allocate the space for the return value string object
;
	  mov	  ax,[bp].op			 ;get return vm reg

	  push	  bp				 ;tempsave around call
	  mov	  bp,sp 			 ;get BP set for C call
	  push	  dx				 ;push length
	  push	  STRTYPE
	  push	  ax				 ;push vm reg
	  mov	  C_fn,offset pgroup:alloc_bl
	  call	  far ptr far_C 		 ;allocate string object;
						 ;"alloc_block" takes care
						 ;of overhead matters
	  mov	  sp,bp 			 ;pop C args
	  pop	  bp

	  mov	  bx,[bp].op    		 ;return value VM reg
	  mov	  di,[bx].C_disp
	  mov	  bx,[bx].C_page
	  %LoadPage es,bx			 ;ES:DI is dest object @
	  add	  di,3				 ;skip past string's overhead

	  mov	  si,[bp].msb_ax		 
	  mov	  ds,[bp].selector		 ;DS:SI is string in buffer
	  pop	  cx				 ;CX = length
	  mov	  ax,BLOCK_XFER			 ;copy into scheme heap
	  int	  DOS				 ;Extended Dos function call

	  mov	  ax,ss
	  mov	  ds,ax
	  ret
do_strval endp


do_errval proc	  near
	  mov	  ax,XLI_ERR_VALUE_BAD_TYPE
	  jmp	  error_return
do_errval endp


	  public  pro2real,real2pro,map_real_mem
; REAL2PRO
;  
;  On entry:
;   DS:SI => address of real mode buffer
;   ES:DI => scheme heap
;   DX    =  length
;
;  On exit:
;   CX is number of chars xfered

real2pro  proc	  near
	  push	  ds			; save data segment
	  call	  map_real_mem		; create real window (selector in ax)
; Error Checks here
	  mov	  cx,dx			; cx = length
; WARNING: DS addresses real memory below
	  mov	  ds,ax			; real mode selector
	  xor	  si,si			; ds:si = source (real data)
	  mov	  ax,BLOCK_XFER		; do block xfer
	  int	  DOS
	  mov	  ax,ds
	  mov	  es,ax			; es = mapped selector
	  mov	  ax,DELETE_SEG		; Delete Segment
	  int	  DOS
	  jnc	  r2p_next
	  xor	  bx,bx
	  mov	  bl,ss:xesc_func
	  shl	  bx,1
	  mov	  cx,ss:which_func[bx]
	  mov	  bx,offset dl_seg
	  jmp	  fatal_pro_err		;control will not return here
r2p_next:
; WARNING:  DS does not address scheme's data segment above
	  pop	  ds			; restore data segment
	  ret
real2pro  endp


; PRO2REAL
;  Copy data from protected mode memory to real mode memory. If ax is
;  non-zero, then it already contains a real selector where we can move
;  the data - in this case we don't create a real window and delete the
;  segment selector after the copy. 
;
;  On entry:
;   if AX = 0
;     then DX =     length
;	   DS:SI => address of real mode buffer
;	   ES:DI => scheme heap
;     else
;	   AX =	    selector to real mode buffer
;          DX =     length
;	   ES:DI => scheme heap
;
;  On exit:
;   CX is number of chars xfered

pro2real  proc	  near
	  push	  ds			; callers data segment
	  push	  ax			; indicator
	  push	  di			; offset to data
	  or	  ax,ax			; do we have a selector already?
	  jnz	  p2r_010		; yes, don't create real window (jump)
	  call	  map_real_mem		; no,  create real window 
				        ;      selector returned in ax
; Error Checks here
p2r_010:
	  mov	  cx,dx			; cx = length
; WARNING: DS addresses scheme heap below
	  mov	  bx,es
	  mov	  ds,bx
	  pop	  si			; ds:si = source      (in scheme heap)

	  mov	  es,ax			; real mode selector
	  xor	  di,di			; es:di = destination (in real mode)
mode_xfer:
	  mov 	  dx,ax			; tempsave selector
	  mov	  ax,BLOCK_XFER		; do block xfer
	  int	  DOS
	  pop	  ax   			; restore indicator
	  or	  ax,ax			; was a selector passed in?
	  jnz	  mode_xf01		;  yes,  then don't delete it
	  mov	  es,dx			; es = mapped selector
	  mov	  ax,DELETE_SEG		; Delete Segment
	  int	  DOS
	  jnc	  mode_next
	  xor	  bx,bx
	  mov	  bl,ss:xesc_func
	  shl	  bx,1
	  mov	  cx,ss:which_func[bx]
	  mov	  bx,offset dl_seg
	  jmp	  fatal_pro_err		;control will not return here
mode_next:
; WARNING:  DS does not address scheme's data segment above
mode_xf01:
	  mov	  ax,ds
	  mov	  es,ax			; restore ptr to scheme heap
	  pop	  ds			; restore data segment
	  ret
pro2real  endp

; MAP_REAL_MEM
;   Map a real memory address into a selector for use in protected memory.
;
;   DS:SI => address of real mode buffer
;   DX    =  length
;
;  On exit:
;   Carry flag set on error
;   AX = selector for real memory or error if carry flag set
;
;  Regs used: ax,bx,cx,si - all destroyed

map_real_mem proc near
					; create real mode window
	  xor	  ax,ax
	  mov	  cx,4			; shift count
	  mov	  bx,[si]+2      	; bx = real segment address
	  mov	  al,bh			; create 32 bit address in SI:BX
	  shr	  ax,cl
	  shl	  bx,cl			; shift for physical mem calc
	  add	  bx,[si]  		; add effective memory address
	  jnc	  mr_25
	  inc	  ax			; SI:BX = real memory address
mr_25:
	  mov	  si,ax			; si:bx = real memory address
	  xor	  cx,cx			; CX:DX = length
	  mov	  ax,CREATE_WIN		; Create Window function request
	  int	  DOS			; Return selector in AX
	  jnc	  mr_ret
	  xor	  bx,bx
	  mov	  bl,ss:xesc_func
	  shl	  bx,1
	  mov	  cx,ss:which_func[bx]
	  mov	  bx,offset cr_win
	  jmp	  fatal_pro_err		;control will not return here
mr_ret:
	  ret
map_real_mem endp

progx	  ends



	  subttl  Prog segment code definitions
	  page

prog	  segment byte public 'PROG'
	  assume  cs:pgroup
	  extrn   next_SP:near,src_err:near
   	  extrn	  fix_intr:near
	  public  pcinit,set_crtint,reset_crtint,xli_ldall,xli_term,xli_xesc

; PC_INIT
;  Perform initializations, some of which are PC specific.
;
pcinit	  proc	  near
	  call	bid_rpc			;bid the real mode code
	  cmp	pcs_sysd,0		;have we found the system directory?
	  jz	pcini_00		; no,  skip loading of xli
	  call	xli_ldall		; yes, load xli stuff
pcini_00:
	  call	pc_init			;get specific pc info
	  call	fix_intr		;take over interrupts
	  ret				;return to caller
pcinit	  endp


; The following routines are gateways to routines in the progx segment
; for real procedure calls (RPC) and external language interface (XLI).
; Note that the progx routines are jumped to via the FAR_RPC table, however 
; they return to the caller of this routine because we fix up the stack.
; 
bid_rpc   proc	  near
	  mov	  bx,frpc_bid  		;initialize real procedure
	  jmp	  rpc_call
pc_init:
	  mov	  bx,frpc_init 		;get machine type
	  jmp	  rpc_call
set_crtint:
	  mov	  bx,frpc_setcrt	;set crt interrupt
	  jmp	  rpc_call
reset_crtint:
	  mov	  bx,frpc_resetcrt	;reset crt interrupt
	  jmp	  rpc_call
xli_ldall:
	  mov	  bx,frpc_ldall  	;load xli files
	  jmp	  rpc_call
xli_term:
	  mov	  bx,frpc_unld    	;unload xli files
	  jmp	  rpc_call
xli_xesc: 
	  mov	  bx,frpc_xesc 		;perform xesc 
	  jmp	  rpc_call
rpc_call:
	  pop	dx			;pop return address
	  push	prog			;push segment return
	  push	dx			;then offset
	  jmp	dword ptr FAR_RPC+[bx]	;jump to progx routine
	  ret				;we'll never return here
bid_rpc   endp

; Far linkage *from* XLI
; (all the memory allocation routines are written in C).
; The caller of this should have set BP from SP before pushing the C args,
; then restore SP from BP afterwards to remove them from the stack.
; We don't preserve ES across the call.
     	  public  far_C
far_C	  proc	  far
	  push	  ds			;C likes ES=DS
	  pop	  es
	  pop	  C_retadr	        ;get far @ off stack so C sees its args
	  pop	  C_retadr+2
	  call	  [C_fn]
	  push	  C_retadr+2
	  push	  C_retadr
	  ret				;C returns with return value in AX..DX
far_C	  endp

prog	  ends

	  end