
 # @(#)mon532core.s
 # @(#)Copyright (C) 1988 National Semiconductor Corp.
	.width	130
 #
 #(**********************************************************************)
 #(*									*)
 #(* 	Copyright (c) 1987, 1988 by National Semiconductor Corporation	*)
 #(*									*)
 #(*	National Semiconductor Corporation				*)
 #(*	2900 Semiconductor Drive					*)
 #(*	Santa Clara, California 95051					*)
 #(*									*)
 #(*	All rights reserved						*)
 #(*									*)
 #(*	This software is furnished under a license and may be used	*)
 #(*	and copied only in accordance with the terms of such license	*)
 #(*	and with the inclusion of the above copyright notice. This	*) 
 #(*	software or any other copies thereof may not be provided or	*)
 #(*	otherwise made available to any other person. No title to and	*)
 #(*	ownership of the software is hereby transferred.		*)
 #(*									*)
 #(*	The information in this software is subject to change without   *)
 #(*	notice and should not be construed as a commitment by National  *)
 #(*	Semiconductor Corporation.					*)
 #(*									*)
 #(*	National Semiconductor Corporation assumes no responsibility	*)
 #(*	for the use or reliability of its software on equipment		*)
 #(*	configurations which are not supported by National		*) 
 #(*     Semiconductor Corporation.					*)
 #(*									*)
 #(**********************************************************************)
 #
 #       program     mon532core
 #       version     1.00
 #
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
 .file "mongxcore.s"
 
 
 #
 #  m o n i t o r    i n t e r r u p t s    &   t r a p s.
 #
 #

#define NOMMU (defined(mon32gx) || defined(monlx32) || defined (mongx320))
#if (defined (NEVER))
#	define	ETHER
#endif

# if (NOMMU)
#   define	    MOVSUB	movb
#   define	    MOVSUW	movw
#   define	    MOVSUD	movd
#   define	    MOVUSB	movb
#   define	    MOVUSW	movw
#   define	    MOVUSD	movd
# else
#   define	    MOVSUB	movsub
#   define	    MOVSUW	movsuw
#   define	    MOVSUD	movsud
#   define	    MOVUSB	movusb
#   define	    MOVUSW	movusw
#   define	    MOVUSD	movusd

# endif

#include "def.s"


	.globl	reset,inttab,berrt
#ifdef mon32gx
	.globl	dir0_iss,derr_iss, modtab
#endif 

#ifdef mon532
	.globl mdiag_ret,abtrt
#endif 
	.globl	msgent,erent,getput,sprinta,srdlin
	.globl	printa,rdlin,hxtobn,bntohx,mainlp
	.globl  hexan, mnexit, bptrt, trcrt, nmirt, nvirt
	.globl	fpurt,illrt,mdvzrt,flgrt,undrt,svcrt


 #
 #   r e s e t    r o u t i n e
 #

.text

#ifdef mon532
.align 4
reset::
	br	gorom+prom_start	# jump to rom start address
gorom:
	bicpsrw	$psrs			# {stop execution if psr_u on}
	movd	$bcr,r3			### init board control register
	movb	$0xbf,0(r3)		### no ROMswap disable cache no parity
	movd	$vme_ctl,r3
	tbitb	$sfl,0(r3)
  	bfs	diagnos			# yes, run diagostics
i_usrt:
	addr	usrti_ret,r7		# else init usrts
	br	usrt_init
usrti_ret:
	movqd	0,r7			# no power on diagnostics
mdiag_ret:
	movd	$vme_ctl,r3		# init vme control register
	movb	$0xef,0(r3)		# clear SFL bit
	movd	$bcr,r3			# get board control reg address
	movb	$0xbf,0(r3)		# no ROMswap disable cache parity
	movd	$duart_addr,r2		# usrt address; test input port
	tbitd	$nvmem, iopcr(r2)	# vmem board exists?
	bfs	ncine			# if not - dont enable cache
	sbitb	$tfls,0(r3)		# set and clear tag flash bit
	cbitb	$tfls,0(r3)		# to init tag memory
        cbitb   $ecinh,0(r3)            # enable cache
ncine:
	movd	$modad,r3		# get mod table address
	movmd	modtab,0(r3),4		# copy mod table to ram address modtab
	lprw	mod,r3			# init mod reg
	lprd	sb,0(r3)		# init sb reg
	movd	r0,svr0(sb)		# save last value of pc
	movd	r1,svr0-4(sb)		# save last value of psr
	addr	inttab,r1		# get interupt dispatch table address
	lprd    intbase,r1		#intbase:=address of inttab(ind. expt.)
	movd	r1,rstint(sb)		# save reset intbase
	addr    stackl(sb),r1		# sp:=address of stack erea
	lprd    sp,r1			#   ( sp:=sb+stackl)
	movd	r1,mnsph(sb)		# mnsph := r1 {set high of mon sp}
	addr    256(r1),svis(sb)	# svis:=sp+256 init use is
	cmpqd	0,r7			# power on?
	beq	no_diag			# yes, save ram size
	movd	r4,ram_size(sb)		# save ram size returned by diag
no_diag:
	movqd   $stalon,opmod(sb)	# operation mod := stand alone
					# term a no echo no cr lf
					# mon_usr := monitor  pndf := false
	addr    term1(sb),r7		# dtrm:=term1
	movd    r7,dtrm(sb)
	movqw   $trma,ndtrm(sb)		# ndtrm:=trma (* set term a as default
					# svcpf := false;
	movqd   0,svpc(sb)		# user_pc := 0
	movqd	0,svpsr(sb)		# user_psr := 0
   	movqd	$0,lstfrm(sb)		#$reset protmp, protoc, lstfrm, proerr 
   	movqd	$0,profld(sb)		#$reset profld, fldfrm, etc. 
	movd	$0x11130c02,cntrlb(sb)	# init cntrl/b cntrl/l cntrl/s cntrl/q
	movzbd  $nswbpt+1,r1		# init software bpr array
rst1:   movqd   0,brkar-4(sb)[r1:d]	# for i:=1,nswbpt do brkar:=0
	acbb    -1,r1,rst1		# also resets stepflg,ackflg,expflg,ins
	addr    begina,strtadr(sb)	# save start address
	addr    endint,endadr(sb)	# save end interrupt routine address
 #
rst3:	movd    $0x0,svmcr(sb)		# user mcr = 0
	movd	$0x0,mnmcr(sb)		# monitor mcr := 0
	movd	$0,mnmsr(sb)		# monitor msr := 0
	movqb	$true,rbptf(sb)		# set break point rem flag.
        movd	$0xa00,svcfg(sb)	# enable internal caches

        lprd    cfg,$0xa00              # enable data & instruction caches
	lprd	dcr,$0			# clear debug control reg.
 	lprd	dsr,$0     		# clear debug status reg.
	lprd	car,$0   		# load car
	lprd	bpc,$0  		# load bpc

	movd	$bcr,r1			# get bcr address
	cbitb	$1,0(r1)
	movd	$false,ivflg(sb)	# init print ivar flag.

noboot:	bsr     mainlp			# type monitor reset message

#endif /* mon532 */
#ifdef	mon32gx
.align 4
reset::

	br	gorom+prom_start	# jump to 'real' prom location
gorom:

 # Check if power-on or reset.  If reset, do not do diagnostics

 	movb	$0x80, uart1+u_lcr	# enable divisor latch, ch. 1
	movzbd	switchp, r2		# get current baud selection
	andb	$0x0f, r2		# mask lower four bits for index
 	cmpb	uarttb[r2:w], uart1	# comp. constant with uart value (low)
	bne	diagnos			# if not the same, must be power-up
 	cmpb	uarttb+1[r2:w], uart1+busof	# compare upper value
	bne	diagnos			# execute board diagnostics
	addr	ui_rtn, r7		# init uarts (ram overlay,etc)
	br	uart_init
ui_rtn:
	addr	diag_ret, r7		# size ram, value returned in r4
	br	size_ram

diag_ret::
	movd	$modad,r3		# get mod table address
	movmd	modtab,0(r3),4		# copy mod table into ram

	lprw	mod,r3			# init mod reg
	lprd	sb,0(r3)		# init sb reg

	movd	r0,svr0(sb)		# save last value of pc
	movd	r1,svr0-4(sb)		# save last value of psr

	addr	inttab,r1		# get interrupt dispatch table address
					# from prom
	lprd    intbase,r1		#intbase:=address of inttab(ind. expt.)
	movd	r1,rstint(sb)		# save reset intbase
	addr    stackl(sb),r1		# sp:=address of stack area
	lprd    sp,r1			#   ( sp:=sb+stackl)
	movd	r1,mnsph(sb)		# mnsph := r1 {set high of mon sp}
	addr    256(r1),svis(sb)	# svis:=sp+256 init use is

	movd	r4, ram_size(sb)	# ram size returned by diags in r4
	movqd   $stalon,opmod(sb)	# operation mod := stand alone
					# term a no echo no cr lf
					# mon_usr := monitor  pndf := false
	addr    term1(sb),r7		# dtrm:=term1
	movd    r7,dtrm(sb)
	movqw   $trma,ndtrm(sb)		# ndtrm:=trma (* set term a as default
					# svcpf := false;
	movqd   0,svpc(sb)		# user_pc := 0
	movqd	0,svpsr(sb)		# user_psr := 0
   	movqd	$0,lstfrm(sb)		#$reset protmp, protoc, lstfrm, proerr 
   	movqd	$0,profld(sb)		#$reset profld, fldfrm, etc. 
	movd	$0x11130c02,cntrlb(sb)	# init cntrl/b cntrl/l cntrl/s cntrl/q
	movzbd  $nswbpt+1,r1		# init software bpr array
rst1:   movqd   0,brkar-4(sb)[r1:d]	# for i:=1,nswbpt do brkar:=0
	acbb    $-1,r1,rst1		# also resets stepflg,ackflg,expflg,ins
	addr    begina,strtadr(sb)	# save start address
	addr    endint,endadr(sb)	# save end interrupt routine address
 #
rst3:	
	movqb	$true,rbptf(sb)		# set break point rem flag.
        movd	$0xa00,svcfg(sb)	# enable internal caches

        lprd    cfg,$0xa00              # enable data & instruction caches
	lprd	dcr,$0			# clear debug control reg.
 	lprd	dsr,$0     		# clear debug status reg.
	lprd	car,$0   		# load car
	lprd	bpc,$0  		# load bpc

	bsr     mainlp			# type monitor reset message

#endif /* mon32gx */ 
#ifdef monlx32
.align 4
reset::
_main::
#ifndef	RAM

	movd	$gorom,r3
	jump	0(r3)			# jump to 'real' prom location
gorom:
	bicpsrw $psrs
	movd	$bd_ctrl, r3
	cbitb	$0, 0(r3)		# turn swap rom inactive

 # Check if power-on or reset.  If reset, do not do diagnostics

	#movzbd	@dip_switch, r3		# check bit 7 on dip switch
	#tbitb	$0,r3
	#bfs	diagnos			#  go to diagnostic if set
	
        				# check bit0 of MIO register to see
        tbitb   $0, @mio_out            # if it is power-up or reset
        bfs     diagnos                 # if power-up, run diagnostics
skip_diag:
diag_ret::
	call	uart_init		# init uarts (ram overlay,etc)
	call	get_dram_size		# size ram, value returned in r4
	

	cbitb	$0,@mio_out		# cold/hot start indicator
#else
	bicpsrw	$psrs
#endif	    (* RAM *)
	movd	$modad,r3		# get mod table address
	movmd	modtab,0(r3),4		# copy mod table into ram

	lprw	mod,r3			# init mod reg
	lprd	sb,0(r3)		# init sb reg

	movd	r0,svr0(sb)		# save last value of pc
	movd	r1,svr0-4(sb)		# save last value of psr

# if	(!defined (ISE) && !defined (RAM))
	addr	inttab,r1		# get interrupt dispatch table address
					# from prom
	lprd    intbase,r1		#intbase:=address of inttab(ind. expt.)
# endif
	movd	r1,rstint(sb)		# save reset intbase
	addr    stackl(sb),r1		# sp:=address of stack area
	lprd    sp,r1			#   ( sp:=sb+stackl)
	movd	r1,mnsph(sb)		# mnsph := r1 {set high of mon sp}
	addr    svrsp(sb),svis(sb)	# svis:=sp init use is

	movd	r4, ram_size(sb)	# ram size returned by diags in r4
	movqd   $stalon,opmod(sb)	# operation mod := stand alone
					# term a no echo no cr lf
					# mon_usr := monitor  pndf := false
	addr    term1(sb),r7		# dtrm:=term1
	movd    r7,dtrm(sb)
	movqw   $trma,ndtrm(sb)		# ndtrm:=trma (* set term a as default
					# svcpf := false;
	movqd   0,svpc(sb)		# user_pc := 0
	movqd	0,svpsr(sb)		# user_psr := 0
   	movqd	$0,lstfrm(sb)		#$reset prot_chng, protoc, lstfrm, proerr 
   	movqd	$0,profld(sb)		#$reset profld, fldfrm, etc. 
	movd	$0x11130c02,cntrlb(sb)	# init cntrl/b cntrl/l cntrl/s cntrl/q
	movzbd  $nswbpt+1,r1		# init software bpr array
rst1:   movqd   0,brkar-4(sb)[r1:d]	# for i:=1,nswbpt do brkar:=0
	acbb    $-1,r1,rst1		# also resets stepflg,ackflg,expflg,ins
	addr    begina,strtadr(sb)	# save start address
	addr    endint,endadr(sb)	# save end interrupt routine address
 #
rst3:	
	movqb	$true,rbptf(sb)		# set break point rem flag.
        movd	$0xa00,svcfg(sb)	# enable internal caches

# ifndef  ISE
        lprd    cfg,$0xa00              # enable data & instruction caches
	lprd	dcr,$0			# clear debug control reg.
 	lprd	dsr,$0     		# clear debug status reg.
	lprd	car,$0   		# load car
	lprd	bpc,$0  		# load bpc
# endif
	movzbd	@dip_switch, r3		# check bit 6 on dip switch
	tbitb	$1,r3
	bfc	nodemo			#  

	movd	$demo_entry,svpc(sb)
	movqd	$0,svpsr(sb)
	movqd	$2,ackflg(sb)		# acknoledge flag = 2 for mainlp
	movb	$0x0c,ophnd(sb)
	br	mnexit

nodemo:
	bsr     mainlp			# type monitor reset message

   
#endif monlx32   
#ifdef mongx320
 #
	.align 4
reset::
_main::
#ifndef  RAM
	br	gorom+prom_start	# jump to 'real' prom location
gorom:
	movb	$led_P, led		# enable RAM, put 'P' on LED
	addr	ui_rtn, r7		# init uarts (ram overlay,etc)
	br	uart_init
ui_rtn:
	addr	size_rtn, r7		# size ram, value returned in r4
	br	size_ram
size_rtn:
#else
	bicpsrw	$psrs
#endif	    (* RAM *)
	movd	$modad,r3		# get mod table address
	movmd	modtab,0(r3),4		# copy mod table to ram address modtab
	lprw	mod,r3			# init mod reg
	lprd	sb,0(r3)		# init sb reg
	movd	r0,svr0(sb)		# save last value of pc
	movd	r1,svr0-4(sb)		# save last value of psr
#ifndef	RAM
	addr	inttab,r1		# get interupt dispatch table address
					# from prom
	lprd    intbase,r1		#intbase:=address of inttab(ind. expt.)
#endif
	movd	r1,rstint(sb)		# save reset intbase
	addr    stackl(sb),r1		# sp:=address of stack erea
	lprd    sp,r1			#   ( sp:=sb+stackl)
	movd	r1,mnsph(sb)		# mnsph := r1 {set high of mon sp}
	addr    svrsp(sb),svis(sb)	# svis:=sp+256 init use is
	movd	r4,ram_size(sb)		# ram size is returned in r4
	movqd   $stalon,opmod(sb)	# operation mod := stand alone
					# term a no echo no cr lf
					# mon_usr := monitor  pndf := false
	addr    term1(sb),r7		# dtrm:=term1
	movd    r7,dtrm(sb)
	movqw   $trma,ndtrm(sb)		# ndtrm:=trma  set term a as default
					# svcpf := false;
	movqd   0,svpc(sb)		# user_pc := 0
	movqd	0,svpsr(sb)		# user_psr := 0
   	movqd	$0,lstfrm(sb)		#$reset promtp, protoc, lstfrm,proerr 
   	movqb	$0,lstchr1(sb)		#$reset lstchr1
   	movqd	$0,profld(sb)		#$reset profld, fldfrm, etc. 
	movd	$0x11130c02,cntrlb(sb)	# init cntrl/b cntrl/l cntrl/s cntrl/q
	movzbd  $nswbpt+1,r1		# init software bpr array
rst1:   
	movqd   0,brkar-4(sb)[r1:d]	# for i:=1,nswbpt do brkar:=0
	acbb    $-1,r1,rst1		# also resets stepflg,ackflg,expflg,ins
	addr    begina,strtadr(sb)	# save start address
	addr    endint,endadr(sb)	# save end interrupt routine address
rst3:
 ###	movd    $0x0,svmcr(sb)		# user mcr = 0
 ###	movd	$0x0,mnmcr(sb)		# monitor mcr := 0
 ###	movd	$0,mnmsr(sb)		# monitor msr := 0
	movqb	$true,rbptf(sb)		# set breakpoint rem flag.
        movd	$0xa00,svcfg(sb)	# enable internal caches
        lprd    cfg,$0xa00              # enable data & instruction caches
	lprd	dcr,$0			# clear debug control reg.
 	lprd	dsr,$0     		# clear debug status reg.
	lprd	car,$0   		# load car
	lprd	bpc,$0  		# load bpc

	movzbd	@dip_switch, r3		# check bit 6 on dip switch
	tbitb	$6,r3
	bfc	nodemo			#  

	movd	$demo_entry,svpc(sb)
	movqd	$0,svpsr(sb)
	movqd	$2,ackflg(sb)		# acknoledge flag = 2 for mainlp
	movb	$0x0c,ophnd(sb)
	br	mnexit

nodemo:

	bsr     mainlp			# type monitor reset message

#endif

begina:

#ifdef	ETHER
        .globl _back2mon
_back2mon:
        bsr     mnentr
        br      error
#endif
 #
 #
 #   m n e n t r     (* m o n i t o r    e n t e r    r o u t i n e *)
 #
mnentr:
        movd    0(sp),scrch2(sb)	#save return address of calling routine
	cmpqb   mont,mon_usr(sb)	# if mon_user<> mont then (user time)
	beq     mnentr3			# begin
	movzwd  8(sp),svmod(sb)		#   save mod  of user program
	movw    10(sp),svpsr(sb)	#   save psr
	movd    4(sp),svpc(sb)		#   save pc
	addr    12(sp),svis(sb)		#   save is
	bispsrw $psrs			#   psr-s :=1
	addr    0(sp),svus(sb)		#   save us
	sprd    fp,svfp(sb)		#   save fp

	sprd	cfg,svcfg(sb)		#   save user cfg
	tbitb	$cfg_de,svcfg(sb)	#   direct exception mode?
	bfs	svgen			
	movd	0(svmod(sb)),svsb(sb)	#     no - save user sb

svgen:
	addr    svr0+4(sb),scrch1(sb)	# 
	lprd    sp,scrch1(sb)		#   sp:= address of svr0
	save    [r0,r1,r2,r3,r4,r5,r6,r7] # save r0-r7
					# end;
	lprw    psr,mnpsr(sb)		# load monitor psr
	lprd    sp,mnsp(sb)		# load monitor sp
	restore [r0,r1,r2,r3,r4,r5,r6,r7] # load monitor r0-r7
	lprd    fp,mnfp(sb)		# load monitor fp
	movd    scrch2(sb),0(sp)	# put return address on stack
#ifdef mon532 

	tbitd	$cnfmmu,svcfg(sb)	# if cfg.mmu on  then

	bfc	mnentr3			#   begin
	cmpqb	true,mcrwf(sb)		#     if mcr was not saved then
	beq	mnentr2			#	begin
	smr	mcr,tmpmcr(sb)		#	  save mcr;
	smr	msr,svmsr(sb)		#	  save msr;
	lmr	mcr,mnmcr(sb)		#	  mcr := monitor mcr;
	lmr	msr,mnmsr(sb)		#	  msr := monitor msr;
mnentr2:				#       end;
	movd	tmpmcr(sb),svmcr(sb)
#endif 
mnentr3:				#   end;
	addr    outb(r7),r6		# init dtrm.outb
#ifdef mon532
	movqb	false,mcrwf(sb)		# mcrwf := false {for monitor time abt}
#endif 
	cmpqb   mont,mon_usr(sb)	# if mon_user<> mont then
	beq     brkex			# begin
	cmpqb	$true,rbptf(sb)		# is breakoint remove needed
	bne	brkex
 #
 # break - point remove
 #

brkrmv:	
	movzbd	$nswbpt,r0		# for i := nswbpt downto 1 do
brkrmv1:
	movd    brkar-4(sb)[r0:d],r2	#begin  
	cmpd	$0,r2			# no breakpoint if 0
	beq	brkrmv2
	cmpb    $bptc,ins-1(sb)[r0:b]   #if brkar[i]<>bpt then{not multi break}
	beq	brkrmv2
	MOVSUB  ins-1(sb)[r0:b],0(r2)	#   m(brkak[i].addr):=ins[i];
					#    (* reload instruction to memory *)
        sprd    cfg,tos               	#####
        lprd    cfg,$0
        lprd    cfg,tos


brkrmv2:
	acbb    -1,r0,brkrmv1           # end for
brkex:	
	ret     0

 #
 #
 #   m n e x i t     (*  m o n i t o r   e x i t     r o u t i n e  *)
 #
mnexit:
	movqb	false,pndf(sb)		# reset pending interrupt flag
	sprd    fp,mnfp(sb)		# save monitor fp
	sprw    psr,mnpsr(sb)		# save monitor psr
	lprd	sp,mnsph(sb)		# mon sp := mon.sp high
	save    [r0,r1,r2,r3,r4,r5,r6,r7] # save monitor r0-r7
	sprd    sp,mnsp(sb)		# save monitor sp
	movqb   usert,mon_usr(sb)	# mon_usr:= user time
	bispsrw $psrs			# set s bit in psr {load us}
	lprd    sp,svus(sb)		# load user  us
	lprd    fp,svfp(sb)		# load fp
	bicpsrw $psrs			# psr-s:=0
	addr    svr7(sb),scrch1(sb)
	lprd    sp,scrch1(sb)		# sp:= address svr7
	restore [r0,r1,r2,r3,r4,r5,r6,r7] # load r0-r7
	lprd    sp,svis(sb)		# load is
	cbitb   $psr_p,svpsr(sb)	# clear p bit in psr
	movw    svpsr(sb),tos		# prepare return push psr
	movw    svmod(sb),tos		# push mod
	movd    svpc(sb),tos		# push pc
#ifdef mon532
mnext2:

	tbitd   $cnfmmu,svcfg(sb)	# if config.mmu then

	bfc     mnext1			#   begin
	smr	mcr,mnmcr(sb)		#     mnmcr := monitor mcr;
	lmr     mcr,svmcr(sb)		#     mcr := svmcr {load mcr}
	lmr     msr,mnmsr(sb)		#     msr := 0 {clear msr}
	movqb	false,mcrwf(sb)		#     mcrwf := false {save nsr flag}

#endif 
mnext1: 
	tbitb	$cfg_de,svcfg(sb)	# direct exception?
	bfc	mnret			# no, return
	lprd	sb,svsb(sb)		# yes, load user sb
mnret:

	rett    0			#   end;


 #
 #
 #   multi interrups check & remove
 #
multich:
	cmpqb	mont,mon_usr(sb)	# if  not monitor_time  and psr_u = 0
	beq	mul3			#then
	tbitd	$psr_u,10(sp)		#begin
	bfs	mul3
	cmpd    4(sp),strtadr(sb)	#   if user_pc>=monitor begin
	blt     mul3			#   then
	cmpd    4(sp),endadr(sb)	#     if user_pc<=monitor end
	bgt     mul3			#     then
mul2:   adjspb  $-4			#       remove last interrupt
	tbitb	$cfg_de,svcfg(sb)	# direct exception?
	bfc	mul2ret			# no, return
	lprd	sb,svsb(sb)		# resturn user sb
mul2ret:
	rett    0			#       return trap
mul3:   ret     0			#   else ; {return to caller}

 
 #
 #
 #  entry to delay interrupts while svc time
 #
mulpnd: 
	movqb	true,pndf(sb)		# flag pennding interrupt
	cmpqb   pndmod,mon_usr(sb)	# if not pennding mod
	bne     multich			# then goto multich
	br      mul2			# else  delete interrupt

 #
 #
 #
 #		   b r e a k    r e m o v e
 #
 #     removes  bpt instruction of each active break points
 #

mesg:   .byte   'B',' '			#$ break point message
litret: .ascii	" RET"
litend:	.ascii	" END"
littrc: .ascii	" TRC"

litdbg: .ascii  " DBG"

 
 #
 # check for break point on the current instruction
 #

ck_brk: 
	movqb	1,r4			# testbp := 1; entry from bpt
	br	ck_brk0
ck_brkt:movqb	2,r4			# entered from trace
ck_brk0:cmpqb	mont,mon_usr(sb)	# if monitor time return
	beq	ck_brkex
	movqb   mont,mon_usr(sb)	# mon_user:= monitor time
	movd	svpc(sb),r1		# r1 := user_pc
	movzbd	$nswbpt,r0		# for i := nswbpt downto 1 do
brk_lp:	cmpd    brkar-4(sb)[r0:d],r1	#begin  
	beq	ck_brk4
	acbb    -1,r0,brk_lp		# end for
 					# not found in break point array
	cmpd	r1,endpc(sb)		# if use_pc = return from cxp then
	bne     ck_brkex		# begin
	cmpqb	1,r4			# entered from bpt handler
	beq	ck_brk6			# then ok - print message
					# if 0(svpc(sb)) = bptc then
	tbitd	$psr_u,svpsr(sb)	# {do move or movus according to psr_u}
	bfc	ck_brk7 
	MOVUSB	0(r1),scrch2(sb)
	br	ck_brk8 
ck_brk7:movb	0(r1),scrch2(sb)
ck_brk8:cmpb	$bptc,scrch2(sb)	#  {end of cxp or end of program}
	bne	ck_brkex
ck_brk6:movmd   oldpc(sb),svpc(sb),2 #svpc:=oldpc svus:=oldus svis:=oldis svmod
	movd    litret,1(r6)    	# $$$  outb(dtrm.outlm):= "ret"
	movd	endpc1(sb),endpc(sb)	#     reload endpc of begin
	acbb    -1,cxpflg(sb),ck_brk9  	#     cxpflg:=cxpflg-1;
	movd    litend,1(r6)    	#if cxpflg(sb)=0 "b end" {end of prog}
ck_brk9:movw    mesg,0(r6)      	#     outb(dtrm.outlm):=cr lf b
	addqd   5,r6	    		#     dtrm.outlm:=dtrm.outlm+7
	br      msgent	  		# $end  (go to print message )
ck_brk4:
   	movw    mesg,0(r6)      	# $   outb(dtrm.outlm):=cr lf b
	movb    (hexan+1)[r0:b],2(r6)   # $ outb(dtrm.outlm):= ascii (brkn)
	addqd   3,r6	    	        # $$$   dtrm.outlm:=dtrm.outlm+7
	br      msgent	  		# $$$ end (goto message print)
ck_brkex:	
	ret	0

 #
 #
 #   b p t     r o u t i n e
 #
 #
bptrt:	
	bsr	savesb			# {save user status & load monitor }
	bsr	mnentr			# {save user status & load monitor }
	bsr	ck_brk			# ck_brk {find actual break point}
bpter:  movd	$ebpt,r1		# else
	br      erent			#    error(ebpt)

 #
 #
 #   t r a c e    t r a p    r o u t i n e
 #
 #

	.set	geti,0			# get parameter for getput routine
	.set	notrc,0			# no trace in step_flag
	.set	stpn,1			# step n flag
	.set	stu,2			# stu flag
	.set	stw,3			# stw flag
	.set	stbrk,4			# trace of go
 #
trcrt:
	bsr	savesb			# {save user status & load monitor }
        movqb	pndmod,mon_usr(sb)	#	pending interrupts flag on.
#ifdef mon532

	tbitd   $cnfmmu,svcfg(sb)	# if config.mmu then

	bfc     trct1			#
	cmpqb	true,mcrwf(sb)		# if not mcrwf {multi exception write}
	beq	trcm0
	smr     mcr,tmpmcr(sb)  	#	 tmpmcr:=mcr reg of mmu
	smr	msr,svmsr(sb)		#	 save msr reg.
	movqb	true,mcrwf(sb)		#	 mcrwf:=true {mcr written flag}
trcm0:	movd	tmpmcr(sb),svmcr(sb)
	lmr	mcr,mnmcr(sb)		#    mcr:=monitor mcr
	lmr	msr,mnmsr(sb)		#    msr:=monitor msr
	bsr	multich			# multi interrupt check


trct1:  movqb	$false,rbptf(sb)	# dont remove breakpoints
#else 
	movqb	$false,rbptf(sb)	# dont remove breakpoints
#endif 
	bsr	mnentr			# emnentr {switch to monitor time}
	movqb	$true,rbptf(sb)		# restore breakpoint flag
trct2:	movzbd  stepflg(sb),r1		# r1:=step_flag
trccs:  casew   trcct[r1:w]		# case of step_flag
trcct:  .word   trcer-trccs		#  no monitor trace
	.word   trcstpn-trccs		#  step  n
	.word   trcstu-trccs		#  stu
	.word   trcstu-trccs		#  stw
	.word   trcgo-trccs		#  trace after go
	.word   trcgo2-trccs		#  trace after stn
	.word   trcgo2-trccs		#  trace after stu
	.word   trcgo2-trccs		#  trace after stw
trcer:  movb	$etrc,errtyp(sb)	# 0 : error_type:=etrc
	br      error3
trcgo:					# 1 : trace of go
	cbitd   $psr_t,svpsr(sb)	#       psr_t:=0
trcgo2: movb	$bptc,scrch2(sb)
	tbitd	$psr_u,svpsr(sb)	#      move or movsu according to psr_u
	bfc	trcgot
	MOVSUB  scrch2(sb),0(actbrk(sb))#       m(pc):=bptc (* bpt instrction
	br	trcgoe
trcgot:	movb	$bptc,0(actbrk(sb))
trcgoe:

        sprd    cfg,tos               	#####
        lprd    cfg,$0
        lprd    cfg,tos


	addqb   (-stbrk),stepflg(sb)	#	step_flag:=no monitor trace
	cmpqb   notrc,stepflg(sb)   	#       if go & step trace goto trct1
	bne     trct2			#       else
	br	trc5			#         mnexit
trcstpn:				# 2 : trace step n
	acbd	-1,stpcnt(sb),trc5  	#       step_count:=step_count-1
					#       if step_count>0
					#       then return to user
					#       else
trc3:   movd    littrc,1(r6)    	# $$$	outb:=" trc"
	bsr	brkrmv			# remove b.p.
	bsr	ck_brkt			# handle b.p. on current pc
	movw    mesg,0(r6)      	#    outb(dtrm.outlm):=cr lf b
	addqd   5,r6	    		# $$$   dtrm.outlm:=dtrm.outlm+7
	#####


	br      msgent	  		# $$$ end  (go to print message )
trcstu:					# 3 : stu/stu
	movqd   geti,tos		# mnentr (* save user status
	movzbd  stptype(sb),r2 		# getput (get,stuadd.type,stuadd.no)
	movd    stuadd(sb),tos
	bsr     getput			#(* find variable using get-put routine
	andd    stuadd+4(sb),r1 	# var:=var and mask
	cmpqb   stu,stepflg(sb)
	bne     trcstw			# if stepflg=stw goto trctw
	checkd  r0,stuadd+8(sb),r1  	#chk var>=limit.low and var<=limit.up
	bfs     trc5			# if not in bounds then end trace
	br	trc3			# else continue tracing
trcstw:	checkd  r0,stuadd+8(sb),r1  	#chk var>=limit.low and var<=limit.up
	bfs     trc3			# if not in bounds then continue
trc5:   cmpqb	true,pndf(sb)		# else end of trace reached
	bne	trc6			
	movb	$epnd,errtyp(sb)	#	   error pending.
	br	error3
trc6:	
	bsr	mnexit			#	  else return to user



 # 
 #	D B G trap routine
 #
mdbgrt:	
	bsr	savesb			# save user sb get monitor sb
 	bsr     mulpnd			# multich; {check pennding mode}
        movb    $edbg,errtyp(sb)	# error dbg
        cmpqb   mont,mon_usr(sb)	# user time?
	bne	error4        		# no, print error.
#ifdef	ETHER
        cmpqb   3,ackflg(sb)		# In Ethernet mode ?
        beq     Et_nmi			# dont change ackflg, 
#endif
        movqb   1,ackflg(sb)		# yes, ackflg = nmi
        bsr     mainlp			# get next inst

 #
 #
 #  n m i     r o u t i n e
 #
nmirt:  
	bsr	savesb			# {save user status & load monitor }
 	bsr     mulpnd			# multich; {check pennding mode}
	movb	$enmi,errtyp(sb)
	cmpqb   mont,mon_usr(sb)	#if uset time error(nmi)
	bne     error4
#ifdef	ETHER
        cmpqb   3,ackflg(sb)		# In Ethernet mode ?
        beq     Et_nmi			# dont change ackflg, 
#endif
					# just print the message.

	movqb   1,ackflg(sb)		# else reset nmi
	bsr     mainlp			# {ackflg:=1}
#ifdef	ETHER
Et_nmi:
	movqb	pndmod, mon_usr(sb)	#  hold interrupts until end off read
					# reinitialize communication buffer 
					# pointer
	movd	dtrm(sb),r7
	addr	outb(r7),r6
        movw    $'R'+0x100*'N',0(r6)    #   " rn"
        addqd   2,r6                    #    outbuf:= "rn"
	bsr	sprinta
	lprd    sp,mnsph(sb)		# set mon.sp to high
	movqb	false,pndf(sb)
	bsr	srdlin
Et_nmi1:
        cmpd    r5,inlm(r7)		# if scan = end of line go to main lp
	bge     Et_nmi
	cmpb    $space,0(r5)		# if char >=space go to fscn3
	blt     Et_nmi2
	addqd   1,r5			# dtrm.scn := dtrm.scn+1
	br      Et_nmi1
Et_nmi2:  
	cmpb    $'!',0(r5)		#   if chr<>"!"
	bne     Et_nmi
	movqb	mont,mon_usr(sb)	# allow interrupts
	br      mainlp			# end
#endif
 #
 #  Phoney abt processing.  Required while using 532 to emulate
 #  32GX32 since a 532 could concievably experience an abort trap
 #
 #  a b o r t   r o u t i n e
 #
 #
abtrt:
#if (NOMMU)
	movb	$euxp,tos
	br	error2
#endif 

#ifdef mon532
	bsr	savesb			# save user sb get monitor sb
	tbitd   $cnfmmu,svcfg(sb)	# if config.mmu then

	bfc     erabt
	cmpqb	true,mcrwf(sb)		#if not mcrwf {multi exeption write}
	beq	abtm0
	smr     mcr,tmpmcr(sb)		#	tmpmcr:=mcr reg of mmu
	smr	msr,svmsr(sb)		#   
	movqb	true,mcrwf(sb)		# mcrwf := true {mcr written flag}
	lmr	mcr,mnmcr(sb)		# mcr:=monitor mcr
	lmr	msr,mnmsr(sb)		# msr:=monitor msr
abtm0:  tbitd	$psr_u,6(sp)		# if psr_u = false then
	bfs	abr1			# begin
	addr	mnext1,scrch1(sb)	# if abort.address = rett of monitor
	cmpd	0(sp),scrch1(sb)	# then remove return address of monitor
	bne	abr1
	adjspb  $-8
abr1:	bsr	multich			# multich;
	bsr	mnentr			# entr monitor time
	tbitd	$0,svmsr(sb)		#
	bfc	abr17
	tbitd	$1,svmsr(sb)		#tst if 1st level pte or protect except
	bfc	abr2			# 1st level pte invalid
	br	abr3		
abr17:	
abr2:	movb	$envl,errtyp(sb)	# invalid pte
	br	error3
abr3:	movb	$eprt,errtyp(sb)	# protection exception
	br	error3
erabt:	movb	$eabt,errtyp(sb)	#   error(abt);
	br	error4
 

#endif 

 #
 #
 # e r r o r s    &   t r a p s
 #
 #
nvirt:	movb	$envi,tos
	br	error2
fpurt:	movb	$efpu,tos
	br	error2
illrt:	movb	$eill,tos
	br	error2
mdvzrt:	movb	$edvz,tos
	br	error2
flgrt:	movb	$eflg,tos
	br	error2
undrt:	movb	$eund,tos
	br	error2
rbert:	movb	$erbe,tos
	br	error2
berrt:	movb	$eber,tos
	br	error2
ovfrt:	movb	$eovf,tos
	br	error2

 #
 #
 # s v c   r o u t i n e s
 #
 #
svclm:	.byte	14,3
svcrt:
#ifdef	SAFE_SVC
	bicpsrw	$0x800
#endif
	bsr	savesb
	movb	mon_usr(sb),monusr1(sb)	# temp save mon_usr
	movqb	pndmod,mon_usr(sb)	# flag pennding mode:= true
	movw	6(sp),tmppsr(sb)	# save psr
	save	[r0,r3]
	andd	$0xff,r0		# limit r0
	checkb	r0,svclm,r0
	bfc	svcs			# if svc#> svclm error
svcer:	
	restore	[r0,r3]
	movb	$esvc,tos
	br	error2
svcs:	casew	svctb[r0:w]		# branch to svc[r0]
svctb:	.word	svc3-svcs
	.word	svc4-svcs
	.word	svc5-svcs
	.word	svc6-svcs
	.word	svc7-svcs
	.word	svc8-svcs
	.word	svc9-svcs
	.word	svc10-svcs
	.word	svc11-svcs
	.word	svc12-svcs
	.word	svc13-svcs
	.word	svc14-svcs

endint:

 #
 #  s v c 3    r e a d n
 #

svc3:	tbitd	$psr_u,tmppsr(sb)	# if psr_u then svcpf := true
	bfc	svc33
	movqb	true,svcpf(sb)
svc33:	
#ifdef	ETHER
	movqb	1,force_serial(sb)	# flag to force serial link
#endif
	movw	r2,tos
	movw	r3,tos			# rdlin(r2,r3,r1);
	movd	r1,tos
	bsr	rdlin
	movzwd	tos,r2			# r2:= # of read char
#ifdef	ETHER
	movqb	0,force_serial(sb)	# flag to end force serial link
#endif
	cmpqb	5,r0			# of svc=terminal read (svc8)
	bne	svcex			# then
					# buffer[0]:=# of read char
	tbitd	$psr_u,tmppsr(sb)
	bfs	svct1
	movw	r2,-2(r1)
	br	svce1
svct1:	movw	r2,scrch2(sb)
	MOVSUW	scrch2(sb),-2(r1)
svce1:	addqd	4,r2			# add 4 extra vio bytes.
svcex:	restore	[r0,r3]
	addqd	1,0(sp)			# {skip svc instruction. }
svcext:	movqb	false,svcpf(sb)
	cmpqb	true,pndf(sb)		# if pennding interrupt exists
	bne	svcex1			# then
svcex2:	movb	$epnd,errtyp(sb)	# error(pnd)
	br	error4			# else
svcex1:	movb	monusr1(sb),mon_usr(sb)	# flage user time

	tbitb	$cfg_de,svcfg(sb)	# direct exception?
	bfc	svret			# no, return
	lprd	sb,svsb(sb)
svret:

	rett	0

 #
 #  s v c 4   p r i n t n
 #
svc4:	tbitd	$psr_u,tmppsr(sb)	# if psr_u then svcpf := true
	bfc	svc44
	movqb	true,svcpf(sb)
svc44:	
#ifdef	ETHER
	movqb	1,force_serial(sb)	# flag to force serial link
#endif
	movd	r1,tos			# printa (r1,r1+r2,r3)
	movd	r2,tos
	addd	r1,tos
	movzbd	r3,tos
	bsr	printa
#ifdef	ETHER
	movqb	0,force_serial(sb)	# flag to end force serial link
#endif
	br	svcex

 #
 #  s v c 5   v i r t u a l    i / o
 #

	.set	svclin,32		# $$$ max bytes to be send on one line
 #
svc5:	save	[r1,r4,r5,r6,r7]
	movd	dtrm(sb),r7		# repeat
vo1:	movzwd	$svclin,r3		# $$$  if n>linlim n1:=linlim
	cmpd	r3,r2
	ble	vo2			#   else n1:=n;
	movd	r2,r3
vo2:	addr	outb+1(r7),r6		#   outlm:=2;
	movb	$'V',-1(r6)		#   outb[1]:="v"
vo3:	tbitd	$psr_u,tmppsr(sb)
	bfs	svct2
	movb	0(r1),scrch2(sb)
	br	svce2
svct2:	MOVUSB	0(r1),scrch2(sb)
svce2:	movzbd	scrch2(sb),tos
	movw	$0x200,tos		#     bntohx (buffer(i),2,0);
	movqw	0,tos
	bsr	bntohx
	addqd	1,r1			# {buffer pointer:=buffer pointer+1}
	addqd	-1,r2			#     n:=n-1;
	acbd	-1,r3,vo3		#   end; for
	bsr	sprinta			#   sprinta {print outb}
	bsr	rdack			#   read_acknowledge
	cmpqd	0,r2
	blt	vo1			#   until n:=0;
	movd	16(sp),r1		# {bufferr pointer:=1}
vi1:	addr	(outb+1)(r7),r6		# $$$ outlm:=2;
	movb	$'V',outb(r7)		# $$$ outlm[1]:= "v";
	bsr	sprinta			# sprinta {writeln("v cr"}
	bsr	rdack			# bsr read_acknoledge
	cmpqb	true,r6			# if endf<>1
	bne	vioex			# then
vi3:	adjspb	$8			#   repeat
	movd	r5,tos			#     hxtobn (x,inbu[i],2);
	addr	1(r5),tos
	bsr	hxtobn
	movd	tos,r5			#     {update scn}
	cmpqd	true,tos
	beq	vi5 #****Amir REA 1649
	tbitd	$psr_u,tmppsr(sb)
	bfs	svct3
	movb	tos,0(r1)
	br	svce3
svct3:	movb	tos,scrch2(sb)
	MOVSUB	scrch2(sb),0(r1)
svce3:	adjspb	$-3
	addqd	1,r2			#     n:=n+1;
	addqd	1,r1			#     k:=k+1
	br	vi3			# until endf
vi5:
	adjspb	$-4			# REA 1649
	br	vi1   #***
vioex:	restore	[r1,r4,r5,r6,r7]
	br	svcex
 #
 #
 #	rdack read_acknowledge routine.
 #	read input line
 #	  if input is v,cr   endf=1 (r6=1)
 #	  if input is v	     endf=0
 #	  if not v at first char error vio
 #

rdack:	bsr	srdlin			# rdlin(-linlim,nrd,ndrtm,inbuf)
	movb	curfrm(sb),lstfrm(sb)
#ifdef	mongx320
	movb	curchr1(sb),lstchr1(sb)
#endif
	movd	inlm(r7),r6		# inlm:=nrd
rdack1:	cmpb	$'V',0(r5)		# for i:=1,nrd do
	addqd	1,r5
	bne	rdack4			#  if inbuf[i]= "v"
	movqb	1,r6			#  then endf:=0
	cmpb	$cr,0(r5)		#     if inbuf[i]= v,cr
	bne	ackex			#     then endf:=1#
	movqb	0,r6			#     end#
ackex:	ret	0			#   else
rdack4:	cmpb	-1(r5),$space		#     if inbuf[i]> space
	bgt	rdack6
	cmpd	r5,r6			#	or i>nrd
	blt	rdack1			#     then
rdack6:	adjspb	$-4			#	error vio
	restore	[r1,r4,r5,r6,r7]
	restore [r0,r3]
	movb	$evio,tos
	br	error2			#  end for;

 #
 #   s v c 6    u s e r     e r r o r
 #

svc6:	restore [r0,r3]
	movb	$erts,tos	# run time error
	br	error2

 #
 #   s v c 7   g e t   h e a p   p a r a m e t e r s
 #

svc7:	movd	r1,heapp(sb)		# save heap pointer address
	movd	heaps(sb),r1		# load heap start
	movd	heape(sb),r2		# load heap end
	br	svcex

 #
 # s v c 8     t e r m i n a l    i / o
 #

svc8:	cmpqb	stalon,opmod(sb)	 # if opmod=stand alone go vio
	beq	svc5
	tbitd	$psr_u,tmppsr(sb)	# if operation is read
	bfc	svct4
	MOVUSB	0(r1),scrch2(sb)
	cmpqb	0,scrch2(sb)
	addqd	4,r1
	MOVUSW	-2(r1),scrch2(sb)	# r2:=n
	movzwd	scrch2(sb),r2
	br	svce4
svct4:	cmpqb	0,0(r1)
	addqd	4,r1
	movzwd	-2(r1),r2
svce4:	movqb	trma,r3			# io to term a
	beq	svc3			# then svc3(buffer[2],n)
	br	svc4			# else svc4(buffer[3],n)

 #
 # s v c 9      u s e r     s v c
 #
 #   set psr(u)=1 ans returns
 #

svc9:	cmpd	$0x55555555,r1
	bne	svcer
	cbitd	$psr_u,14(sp)		# set u bit in pushed psr
	br	svcex

 #
 # s v c  1 0    e m u l a t e   t r a p
 #
 # trap to descriptor r2. release r3 bytes from stack
 #
 #
 
svc10:
	cmpd	$0x55555555,r1		# if code not 5555555 error
	bne	svcer
	adjspb	$-12			# remove save r0,r3 and ret pc
	movd	tos,scrch2(sb)		# save ret module & psr
svc10a:	andw	$0x0cfd,scrch2+2(sb)	# cleat s u t bits in psr.
	movw	r2,scrch2(sb)		# store return module number
	movzwd	r2,scrch1(sb)		# get modlue number
	lshd	$-16,r2			# get offset
	addd	8(scrch1(sb)),r2	# ret pc :=  start pc+ offset
	movd	r2,scrch1(sb)
	restore	[r0,r1,r2,r3,r4,r5,r6,r7]
	movd	scrch2(sb),tos		# push mod & psr of target
	movd	scrch1(sb),tos		# push target pc
	br	svcext

 #
 # s v c 1 1    t r a p    w i t h o u t   s a v e
 #

svc11:	cmpd	$0x55555555,r1		# if code not 5555555 error
	bne	svcer
	adjspb	$-8			# remove save r0,r3
	addb	svclm+1,r0		# restore old value of r0
	movd	4(sp),scrch2(sb)
	save	[r0,r1,r2,r3,r4,r5,r6,r7]
	br	svc10a

 #
 # s v c  1 2   c o p y   i n t e r r u p t     t a b l e
 #

svc12:	cmpd	$0x55555555,r1		# if code not 5555555 error
	bne	svcer
	sprd	intbase,r0
	lprd	intbase,r2		# for i := 1 to r3 do
svc12a:	movd	-4(r0)[r3:d],-4(r2)[r3:d] # new_inttab[i] := inttab[i]
	acbd	-1,r3,svc12a		# end;
	br	svcex

 #
 # s v c  1 3    r e p l a c e    e n t r y     i n   i n t e r r u p t
 #	       t a b l e
 #

svc13:	cmpd	$0x55555555,r1	# if code not 5555555 error
	bne	svcer
	sprd	intbase,r0	# for i := 1 to r3
	movd	r0[r3:d],tos	# save old entry
	movd	r2,r0[r3:d]	# replace entry n {n is in r3 value in r2}
	movd	tos,r2		# old entry to r2
	br	svcex

 #
 # s v c  1 4   s witch between direct and indirect exception modes" 
 #	       
 #
 
svc14:	cmpd	$0x55555555,r1	# if code not 5555555 error
	bne	svcer
	cmpqd	$0,r2
	bne	mdirexp
	addr	inttab,r3
	lprd	intbase,r3
	sprd	cfg,r3
	cbitd	$cfg_de,r3
	lprd	cfg,r3
	br	svcex
mdirexp: cmpqd	$1,r2
	bne	svcer
	addr	dinttab,r3
	lprd	intbase,r3
	sprd	cfg,r3
	sbitd	$cfg_de,r3
	lprd	cfg,r3
	br	svcex
 #
 #
 #	e r r o r	h a n d l i n g 
 #

	.set	envi,0			# error nvi
	.set	enmi,1			# error nmi
	.set	eabt,2			# error abort
	.set	efpu,3			# error fpu
	.set	eill,4			# error illegal instruction
	.set	esvc,5			# svc error
	.set	edvz,6			# error divide by zero
	.set	eflg,7			# error flag trap
	.set	ebpt,8			# error bpt
	.set	etrc,9			# error trace trap
	.set	eund,10			# error un-defined instruction
	.set	erbe,11		# restartable bus error
	.set	eber,12			# error bus error
	.set	eovf,13		# overflow
	.set	edbg,14		# dbg trap
	.set	extr,15			# error external abort
	.set	eprt,16			# error protection
	.set	envl,17			# error invalid
	.set	eusr,18			# user error
	.set	esrc,19			# search error
	.set	epnd,20			# pennding interrupt error
	.set	ecrc,21			# crc error
	.set	ecxp,22		# error more then one cxp command
	.set	evio,23			# vio protocol error
 # the following errors print a parameter
	.set	evrf,24			# verify error constant
	.set	erts,25			# run time system error.
	.set	epol, 26		# $$$ protocol error
	.set	euxp,25			# unexpected 'abt' - for use only 
					#  for GX32 emulation w/532

 #
 #  errors table
 #

ertab:	.ascii	" NVI NMI"
	.ascii	" ABT FPU"
	.ascii	" ILL SVC"
	.ascii	" DVZ FLG"
	.ascii	" BPT TRC"
	.ascii	" UND RBE"
	.ascii	" BER OVF"
	.ascii	" DBG EXT"
	.ascii	" PRT NVL"
	.ascii	" USR SRC"
	.ascii  " PND CRC"
	.ascii  " CXP VIO"
	.ascii  " VRF RTS"		# this error prints a parameter
	.ascii	" POL"			# $$$ protocol error
	.ascii	" UXP"

 #
error2: 
	bsr     savesb			# save user status load monitor status
	movb	tos,errtyp(sb)		# get error type
error4:
	bsr     mnentr			# save user status load monitor status
	br	err33
error3:	bsr 	brkrmv			# remove break points
err33:
	movqb	mont,mon_usr(sb)	# change to monitor time
	movxbd  errtyp(sb),r1		# load error parameter
	movd	svr0-4(sb),r0		# load number to be printed with error
err34:
erent:
	movd	r7,r6
	movb    $'E',0(r6)  		# insert E
	movxbd  r1,r1
	movd    ertab[r1:d],1(r6)	# insert error message
	addqd   5,r6			# 
	cmpb	r1,$evrf			# if error_number> vrf then
	blt	erent2				#   begin {print also number}
	movb	$space,0(r6)			#      add space
	addqd	1,r6
	movd	r0,tos				#      bntohx(r0,8,2)
	movw	$0x802,tos
	movqw	0,tos				# *** align
	bsr	bntohx				#   end;
erent2: br      msgent				# print message

synterr:
error:  movb    $'?',0(r6)	# writeln (* lf ? *)
	addqd   1,r6			#  outb(ndtrm.outlm):= ?
msgent:
	bsr     sprinta
	br      mainlp			# goto nainlp




 #
 #
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
 #     m o n i t o r    m a i n   l o o p
 #
 #
 #  table of commands name for search
 #
 # register names pc, us etc.

regntb: .byte   'P','C'    ,'U','S'	
	.byte   'I','S'    ,'I','N'
	.byte   'S','B'    ,'F','P'
#ifdef mon532
	.byte   'M','C'    ,'M','M'
	.byte   'M','S'    ,'T','E'
	.byte   'P','T'	   ,'I','V'    
#endif 
	.byte   'S','P'    ,'F','S'
	.byte   'C','F'    ,'H','S'
	.byte   'H','E'    ,'H','P'

	.byte	'D','C'	   ,'D','S'
	.byte	'C','A'	   ,'B','R'


wrreg:  .byte   'M','O'    ,'P','S'
regst:	.byte   'B','P'    ,'R',' '
	.byte	'F',' '	   ,'L',' '
regend: .byte   'M','B'    ,'M','W'	# memory byte,word,double
	.byte   'M','D'
	.set	regtln, (.-regntb) / 2
	.set	wreg,(wrreg-regntb)/2
	.set    wrend,(regst-regntb)/2
	.set	regs,(regst-regntb)/2+1	# first reister which is r,f,l
	.set    mstart, (regend-regntb)/2
	.set	lregno, (regend-regntb)/2-1
 # monitor commnads table

cmndtb: .byte   'M',' '    ,'F',' '
	.byte   'S','R'    ,'L',' '
#ifdef mon532

	.byte	'D','E'	   ,'T',' '	# direct exception, diagnostics

#else 
	.byte	'D','E'	   
#endif 
cmdu:	.byte   'D',' '    ,'S','U'
cmsw:	.byte   'S','W'    ,'J','S'
	.byte   'C','X'    ,'G',' '
	.byte   'S','T'    ,'O','M'
cmp:	.byte   'P',' '    ,'C',' '

#ifdef mon532
	.byte	'B','O'	   		# boot 
#endif 
	.byte	'I','V'			# invalidate
	.byte	'B','L','E','L'     	# begin and end fast load
	.byte   'B',' '	   ,'R','I'
	.byte	'N','P'	   ,'O','P'	# $$$ protocol commands
	.byte	'N','B'			# new breakpoint scheme (dummy)
#ifdef monlx32
	.byte	'T',' '
#endif
	.byte	'V','R'			# version command
	.set	cmntln,(.-cmndtb) / 2
	.set	prc, (cmp-cmndtb)/2	# define print command
	.set	chcm, prc+1		# change command number
	.set	stwc, (cmsw-cmndtb)/2	# stw command number
	.set	jsbc, stwc+1		# jsb command number
crl:    .byte   cr,'L',space		# take away cr

#ifdef monlx32
rmsg:	.ascii	"R GNX MONITOR (MONGX32E) VERSION 4 REV 2 RAM: 0-"
#endif monlx32
#ifdef mon532
rmsg:	.ascii	"R GNX MONITOR (MON532) VERSION 4 REV 2 RAM:0 - "
#endif
#ifdef  mon32gx
rmsg:	.ascii	"R GNX MONITOR (MON32GX) VERSION 4 REV 2 RAM: 0-"
#endif mon32gx
#ifdef mongx320
rmsg:	.ascii	"R GNX MONITOR (MONGX320) VERSION 4 REV 2 RAM:0 - "
#endif

rmsge:
 #
 #
et_msg:
	.ascii	" ETHERNET CONNECTION"
et_msge:

mainlp:
	addr    outb(r7),r6		# dtrm.outlm:=2
	movxbd  ackflg(sb),r3
procs:	casew	protb[r3:w]		# case of ackflg :
protb:	.word	pro0-procs
	.word	pro1-procs
	.word	pro2-procs
#ifdef	ETHER
	.word	pro3-procs		# Ethernet  protocol
#endif
pro0:	
	movb	$cr,0(r6)
	addqd	1,r6
	movd	$(rmsge-rmsg),r0		# "reset"
	addr	rmsg,r1
	movd	r6,r2
	movsb
	addd	$(rmsge-rmsg),r6	#    outbuf:= reset meseg
	movd	ram_size(sb),tos	#    last address of ram
	movb	$8,tos			#    in r0 (set by contest)
	movb	$2,tos			#    in hexa format
	movqw	0,tos			# *** align
	bsr	bntohx			#    bntohx(r0,8,2)
	movqd	$0,lstfrm(sb)		# $$$ back to old protocol on reset
	movqd	$0,profld(sb)		# $$$ reset profld, fldfrm, etc. 

#ifdef	ETHER
        movzbd  @dip_switch,r1          # Get the jumper setting
#ifndef RAM
        #andb    $0x7,r1                 # Test the ethernet
        #cmpqd   1,r1
        #blt     propt1		        # use serial line
	br_on_serial  r1, propt1
	movd    $(et_msge - et_msg), r0 # ethernet acknoledge
	addr	et_msg,r1
	movd	r6,r2
	movsb
	addd	$(et_msge - et_msg),r6
	bsr	sprinta
                                        # else Use ethernet.
#endif
	movzbd	@dip_switch,r1
        #andd    $1,r1                   # extract thin /thick bit
	thin_ether r1
        xord    $1,r1                   # invert logic
        save    [r0,r1,r2]
        movd    r1,tos                  # Pass this info to driver
        bsr     _Einit                  # Try to init NIC
        adjspb  $-4
        restore [r0,r1,r2]
        movqb   3,ackflg(sb)            # flag Ethernet on
	movqb	0,force_serial(sb)	# init force-serial-link to false
        br      mread                   # success, use ethernet.
pro01:
 ###
#endif	(* ETHER *)
 
	br	propt1			#    inlm[dtrm]:=inlm[dtrm]+rmsge-rmsg
pro1:	movw	$'R'+0x100*'N',0(r6)	#   " rn"
	addqd	2,r6			#    outbuf:= "rn"
	br	propt1			#    outlm[dtrm]:=outlm[dtrm]+2
pro2:	movb	$'*',0(r6)		#   "*"
	addqd	1,r6			#    outbuf:= "*"
propt1:
	bsr     sprinta			# print (outb)
 # $$$ begin
	cmpqb	$0,prot_chng(sb)		# protocol to be changed ?
	beq	propt2
	xorb	prot_chng(sb),protoc(sb)
	movqb	$0,prot_chng(sb)
#ifdef ETHER
        br      mread:b
pro3:   
        movb    $'*',0(r6)
	addqb	1,r6
        bsr     sprinta
mread:
#endif ETHER
propt2:					#if op command treat it as in old prot
 # $$$ end
	lprd    sp,mnsph(sb)		# set mon.sp to high
	movqb	false,pndf(sb)
	bsr     srdlin			# call standard read line  routine
 # $$$ begin
	cmpqb	0,proerr(sb)		# protocol error ?
	beq	ckfrmn
	movzbd	proerr(sb),r0		# nature of error
	movb	$epol,r1
	movqb	0,fldfrm(sb)		# reset fast load frame if error
	movqb	0,proerr(sb)		# reset error flag
	br	erent
ckfrmn:	
	cmpqb	0,protoc(sb)		# new protocol?
	beq	fscn
	cmpb	curfrm(sb),lstfrm(sb)	# same frame no as last command?
	bne	ckfrm2			# no, process command
	movd	r7,r6			# yes, simply resend last response
	addr	sresp(sb),r0
	cmpb	$'*',0(r0)		# skip if a simple *
	beq	mainlp
ckfrm1:	movb	0(r0),0(r6)
	addqd	1,r6
	addqd	1,r0
	cmpb	$0,-1(r0)
	bne	ckfrm1
	addqd	-1,r6
	bsr	sprinta
	br	mainlp	
					# new command received
ckfrm2:	movb	curfrm(sb),lstfrm(sb)	# update last frame number
	movzbw	$'*',sresp(sb)		# initialize response for command to
					# * unless overwritten later on
	cmpqb	0,fldfrm(sb)		# fast load frame?
	bne	pfload			# yes, goto fast load routine
 # $$$ end
fscn:   cmpd    r5,inlm(r7)		# if scan = end of line go to main lp
	bge     mainlp

fscn2:  cmpb    $space,0(r5)		# if char >=space go to fscn3
	blt     fscn3
	addqd   1,r5			# dtrm.scn := dtrm.scn+1
	br      fscn
fscn3:  cmpqb   2,ackflg(sb)		# if ackflg <= 2
	ble     fscn4			# then
	cmpb    $'!',0(r5)		#   if chr<>"!"
	bne     mainlp			#   then goto mainlp
	movqb   2,ackflg(sb)		#   else   ackflg:=-1 { not acknoledge}
	br      mainlp			# end
fscn4:  addr    outb(r7),r6		# dtrm.outlm:=1
	addr    cmndtb,tos		# tbsrch (3,cmndtb,(cmndtbe-cmndtb)/4)
	movzbd  $cmntln,tos
	bsr     tbsrch			# (* search commnd-table *)
	cmpqb   true,tos
	bne     synterr			# if not found in command table error
	movb    r2,com_num(sb)		# l:=command-number
maincs: cased   brtd[r2:d]		# main case of command-number
brtd:   .double   movelp-maincs		# move
	.double   fillp-maincs		# fill
	.double   srchlp-maincs		# search
	.double   loadlp-maincs		# load
	.double	  exceptd-maincs	# direct exception
#ifdef mon532
	.double	  testd-maincs		# run full diagnostic tests

#endif 
	.double   mdumplp-maincs	# dump
	.double   stulp-maincs		# step until
	.double   stulp-maincs		# step while
	.double   cxpl-maincs		# jsb
	.double   cxpl-maincs		# cxp
	.double   golp-maincs		# go
	.double   stepl-maincs		# step n
	.double	  opcc-maincs		# operation mod
	.double   prntc-maincs		# print
	.double   prntc-maincs		# change
#ifdef mon532

	.double	  bootcmd-maincs	# boot commnad
#endif 
	.double	  cacheinv-maincs	# cache invalidate
	.double	  blcmd-maincs		# $$$ begin fast download
	.double	  elcmd-maincs		# $$$ end of fast download
	.double   beginl-maincs		# begin
	.double	  rstintl-maincs	# reset intbase
	.double   newprot-maincs	# $$$ change to new protocol
	.double	  oldprot-maincs	# $$$ change to old protocol
	.double	  newbrk-maincs		# new breakpt scheme (dummy command)
#ifdef monlx32
	.double   diagcom-maincs	#call diagnostic
#endif monlx32
	.double	  version-maincs	# return version number and date

 #
 #
 #	s h x t o b n  ( standard hxtobn  call )
 #      returns value in r1.
 #
shxtobn:
	movd	$1,scrch2(sb)	# if not found print error
nshxtobn:
	bsr     comps		# compress leading space's
	adjspb  $8		# (* push dummy word exerr
	movd    r5,tos		# vecp:=dtrm.scn
	movd    inlm(r7),tos    # endp:=dtrm.inlm
	bsr     hxtobn		# hextobn (word,exrr,dtrm.scn,dtrm.inlm)
	movd    tos,r5		# update dtrm.scn
	cmpqd   true,tos
	movd    tos,r1		# r1:=word
	bne     shxtbex		# if exrr then
	cmpqd	$1,scrch2(sb)
	beq	synterr
shxtbex:
	bsr     comps		# compress leading space's
	ret     0
 #
 #

sshxtobn:
	movd	$0,scrch2(sb)	# ignore irrors
	br	nshxtobn
 
 #
 #
 #   p r i n t  &  c h a n g e    c o m m a n d s
 #

	#.set	geti, 0			# get indicator

	.set	temp,-4

	.set	one_reg,1	# one register type
	.set	regs_gp,2	# general purpose registers (r,f,l)
	.set	mem_gp,3	# get put memory
	

 #		type        ! upper ! low  !  length !
 #			    ! bound !bound !	     !
 #	----------------------------------------------

gptbl:	.byte	one_reg,	0,	0,	8	# pc
	.byte	one_reg,	0,	0,	8	# us
	.byte	one_reg,	0,	0,	8	# is
	.byte	one_reg,	0,	0,	8	# intbase
	.byte	one_reg,	0,	0,	8	# sb
	.byte	one_reg,	0,	0,	8	# fp
#ifdef mon532
	.byte	one_reg,	0,	0,	8	# mcr
	.byte	one_reg,	0,	0,	8	# mmsr
	.byte	one_reg,	0,	0,	8	# msr
	.byte	one_reg,	0,	0,	8	# tear
	.byte	regs_gp,	1,	0,	8	# ptb
	.byte	regs_gp,	1,	0,	8	# ivar
#endif 
	.byte	one_reg,	0,	0,	8	# sp
	.byte	one_reg,	0,	0,	8	# fsr
	.byte	one_reg,	0,	0,	4	# cfg
	.byte	one_reg,	0,	0,	8	# hs
	.byte	one_reg,	0,	0,	8	# he
	.byte	one_reg,	0,	0,	8	# hp
	.byte	one_reg,	0,	0,	8	# dcr
	.byte	one_reg,	0,	0,	8	# dsr
	.byte	one_reg,	0,	0,	8	# car
	.byte	one_reg,	0,	0,	8	# bpc
	.byte	one_reg,	0,	0,	4	# mod
	.byte	one_reg,	0,	0,	4	# psr
	.byte	regs_gp,	15,	2,	8	# break points
	.byte	regs_gp,	7,	0,	8	# r0-r7
	.byte	regs_gp,	7,	0,	8	# f0-f7
	.byte	regs_gp,	7,	0,	16	# l0-l7
	.byte	mem_gp,		0,	0,	2	# memory byte
	.byte	mem_gp,		0,	0,	4	# memory word
	.byte	mem_gp,		0,	0,	8	# memory double
 #


prntc:	subb	$prc,r2
	movd	r2,tos			# save get ot put in stack
	addr	regntb,tos
	movzbd	$regtln,tos
	bsr	tbsrch			# search register in reg table.
					# if found r2 = reg number in table
	cmpqb	true,tos
	bne	synterr			# not found
	cmpqb	one_reg,gptbl[r2:d]	# if only one reg - no more parms
	beq	gorp
	bsr	shxtobn			# get hexa number - trans to bin
	cmpqb	mem_gp,gptbl[r2:d]	# is it memory address ?
	beq	gorp			# yes - go to print or change
	checkb	r0,(gptbl+1)[r2:d],r1	# if reg num - check boundaries
	bfs	synterr
gorp:	cmpqb	$geti,0(sp)		# if get goto print 
	beq	gval

 #
 #	change command - call getput with put parameter
 #

	movd	r1,r0			# save register number in r0
	cmpb	$'=',0(r5)		# next xharacter must be '='
	bne	synterr
	addqd	1,r5			# next character
	cmpb	$16,(gptbl+3)[r2:d]	# is it long register
	bne	pch2
	movd	r5,r1			# look for end of long hex number
pch1d:	addqd	1,r1			# next char
	cmpb	$cr,0(r1)		# end of line?
	beq	pch1c			# yes exit
	cmpb	$' ',0(r1)		# space?
	bne	pch1d			# no, continue
pch1c:	subd	$9,r1			# back to end of MS portion
	cmpd	r5,r1			# chaeck if more than 8 digits (MS > 0)
	bge	pch1a			# no, zero out MS
	adjspb	$8			# yes, call hxtobn to get MS portion
	movd	r5,tos			# vecp:=dtrm.scn
	movd	r1,tos			#endp:=dtrm.inln (number of char in MS)
	bsr	hxtobn			#hextobn(word,exerr,dtrm.scn,dtrm.inlm)
	movd	tos,r5			# update dtrm.scn
	cmpqd	true,tos
	movd	tos,fpubuf+4(sb)	# store MS of register
	beq	synterr
	br	pch1b
pch1a:	movqd	$0,fpubuf+4(sb)		# zero out MS of reg
pch1b:	bsr	shxtobn			# get LS part of reg
	movd	r1,fpubuf(sb)		# store LS portion of reg
	br pch2a
pch2:
	bsr	shxtobn			# translate value to binary
pch2a:
	movd	r0,tos			# push register number saved in r0
	bsr	getput			# getput(get,reg_num) r2=reg_type
	cmpb	0(r5),$'V'		# verify ?
	bne	mainlp			# no return to main loop

 #
 #	verify - perform get value and compare get to put
 #

	cmpb	$16,(gptbl+3)[r2:d]		# is it long register
	bne	ver1
	movd	fpubuf(sb),scrch1(sb)	# get ls part of register 
	movd	fpubuf+4(sb),scrch2(sb)   # getmls part of register
	br 	ver11
ver1:	movd	r1,r3			# save the new value in r3
ver11:	movzbd	$geti,tos		# push get
	movd	r0,tos			# push reg number
	bsr	getput			# r1=getput(get,reg_num) r2=reg_type
	cmpb	$16,(gptbl+3)[r2:d]		# is it long register
	bne	ver2
	cmpd	scrch2(sb),fpubuf+4(sb) 	# get ms part of register 
	bne     vererr
	cmpd	scrch1(sb),fpubuf(sb)	# get ls part of register
	br      ver3
ver2:	cmpd	r1,r3
ver3:	beq	mainlp			# verify complited succesfuly
vererr:	movb	$evrf,r1		# verify error
	br	erent

 #
 #	print command	- call getput with get parameter
 #			  the get parameter is already in top of stack
 #			  r2 = register type
 #
 
gval:	movd	r1,tos			# r1 = register number
	bsr	getput			# r1 = getput(get,reg_num)
#ifdef mon532
	cmpd	$true,ivflg(sb)		# was it pivar command?
	bne	gvaln			# no, continue.
	movd	$false,ivflg(sb)	# yes,
	br	err34			# print illegal command error mes.
gvaln:
#endif 
	movb	$'=',0(r6)		# enter '=' to output buffer
	addqd	1,r6
	movd	r1,tos
	cmpb	$16,(gptbl+3)[r2:d]		# is it long register
	bne	gval1
	movd	fpubuf+4(sb),tos         # get ms part of register 
	movb	$8,tos
	movqb	$2,tos
	movqw	$0,tos
	bsr	bntohx
	movd	fpubuf(sb),tos		# get ls part of register
	movb	$8,tos
	movqb	$0,tos
	br 	gval2
gval1:	movb	(gptbl+3)[r2:d],tos	# get return value length in hexa chr
	movqb	$2,tos
gval2:	movqw	$0,tos			#align
	bsr	bntohx			# bntohx(r1,length,2)
	bsr	sprinta
	br	mainlp
 
 #
 #
 #       g o    c o m m a n d
 #
 #  local constants
 #

	#.set	notrc, 0	        # flag of no trace active
	#.set	stpn,  1	        # flag of step n
	#.set	stu,   2	        # flag of step until
	#.set	stw,   3	        # flag of step while
	#.set	stbrk, 4	        # flag of break step
 #

golp:   
	cbitd   $psr_t,svpsr(sb)	# svpsr_t:=0 (* disable trace *)
	movqb   $notrc,stepflg(sb)	# stepflg:=stbrk#
stdgo:  movzbd  $nswbpt,r0		# for i:=nbreak-2 dowen to 1 do
gol1:	cmpd	$0,brkar-4(sb)[r0:d]	# no brkpt if 0
	beq	gol5
	movd    brkar-4(sb)[r0:d],r1
	MOVUSB  0(r1),ins-1(sb)[r0:b]	#     ins[i]:=m(brkar[i].addr)
	cmpd    svpc(sb),r1		#     if brkar[i].addr=pc then
	bne     gol4
	sbitd   $psr_t,svpsr(sb)	#     psr_t:=1 (*set trace mode one  *)
	movd    r1,actbrk(sb)		#     actbrk:=i
	orb	$stbrk,stepflg(sb)	#     stepflg:= stepbrk (*flag go trace
	br      gol5			#      else
					#          m(brkar[i].addr):=bpt;
gol4:	movb	$bptc,scrch2(sb)
	MOVSUB	scrch2(sb),0(r1)	#     if not written  then


        sprd    cfg,tos               	#
        lprd    cfg,$0
        lprd    cfg,tos


	MOVUSB	0(r1),scrch2(sb)	# verify
	cmpb	$bptc,scrch2(sb)
	beq	gol5
	movd	r1,r0			#	    error vrf
	movd	$evrf,r1
	br	erent
gol5:   
        acbb    -1,r0,gol1		# end;
	bsr     mnexit
 
 #
 #
 #       s t e p   n    c o m m a n d
 #

stepl:  movqd   1,stpcnt(sb)	# stepcount:=1
	bsr     sshxtobn	# shxtobn (n) (* ignor error *)
	cmpd	$0,r1		# any number given ?
	beq	stp2		# no - then it will stay one.
	movd    r1,stpcnt(sb)   # stepcount:= n
stp2:   cmpb    $cr,0(r5)       # if dtrm.scn<> cr goto synterr
	bne     synterr
	movqb   stpn,stepflg(sb)# stepflag:=step n
	sbitd   $psr_t,svpsr(sb)# svpsr_t:=1 (* set trace mode *)
	br      stdgo		# goto stdgo;

 #
 #
 #       b e g i n    j s r     c x p    c o m m a d s
 #
beginl:
        sprd    cfg,tos               	#
        lprd    cfg,$0
        lprd    cfg,tos
        movqb   1,cxpflg(sb)	# cxpflg:=1 {flag of begin}
	movqd	0,oldpc(sb)	# oldpc := 0 ; {reset pc after end of program}
	movd	$begin_bpt, endpc(sb) #
	br      cxpl2
cxpl:   cmpqb   2,cxpflg(sb)	# if cxpflg=2 {second cxp}
	bne     cxpl1		# then error cxp
	movd	$ecxp,r1
	br      erent
cxpl1:  movqb   2,cxpflg(sb)	# else cxpflg:=2;
	movmd   svpc(sb),oldpc(sb),2    # save pc,us,is,mod
	movd	endpc(sb),endpc1(sb)	# save endpc of last begin
	movd	$js_bpt, endpc(sb)
cxpl2:  addr    svus(sb),r3		# r3:=addr of us
	tbitd   $psr_s,svpsr(sb)# if psr_s=1 then
	bfs     cxpl3		#   r3:= addr of is
	addr    svis(sb),r3
cxpl3:  movd    0(r3),r0	# r0:=sp
	bsr     shxtobn		# shxtobn (addr)
	movd    r1,r2		# r2:=addr  (*mod *)
	cmpb    $jsbc,com_num(sb)	# if l=cxp then
	beq     cxpl5		# begin
	bsr     shxtobn		#    shxtobn (offset)
	movd    r2,svmod(sb)	#    mod:= read mod
				#    r1:=offset+(8+(mod)) (* new pc *)
	movd	0(r2),svsb(sb)  #    sb := read sb
	MOVUSD	8(r2),scrch2(sb)
	addd	scrch2(sb),r1
	addqd   -4,r0
	movd	svmod(sb),scrch1(sb)	# get mod
	#movb	$bptc,scrch1+2(sb)	# put bpt in the higher byte
	MOVSUD	scrch1(sb),0(r0)	# write it on stack
	#addr	2(r0),endpc(sb)		# save it as end of program addr
	MOVUSD	0(r0),scrch2(sb)	# {verify write}
	cmpd	scrch1(sb),scrch2(sb)	# if was'nt written well go to vrferror
	bne	vrferr1
cxpl5:  movd    r1,svpc(sb)		# go pc:=r1
	addqd   -4,r0
	movd	endpc(sb),scrch2(sb)	# to push the return address
	MOVSUD	scrch2(sb),0(r0)
	MOVUSD	0(r0),scrch1(sb)	# {verify write}
	cmpd	scrch1(sb),scrch2(sb)	# if was'nt written well go to vrferror
	bne	vrferr1
	movd    r0,0(r3)	# update user sp
	cmpqb   2,cxpflg(sb)	# if cxpflg=2 goto golp {to user program}
	beq     golp		# else goto mainlp
	br      mainlp
 
begin_bpt:
	bpt
js_bpt:
	bpt
 
 #
 #
 #       s t e p   u n t i l  /  w h i l e
 #

stulp:  movqb   stw,r3		# r3:=0
	cmpb    $stwc,com_num(sb)	# if l=stw then  (* command is stw *)
	beq     stu2		#   r3:=1
	movqb   stu,r3
stu2:   addr    regntb,tos      # tbsrch(2,regntb,regnln)
	movzbd  $regtln,tos
	bsr     tbsrch
	cmpqb   true,tos	# if  not exitf then  goto synterr
	bne     synterr		# else
	movqd   0,r1		#   n parameter :=0
	cmpqb	one_reg,gptbl[r2:d]	# if only one reg - no more parms
	beq	stu3		#   if regtb[n1,i]=0xff then
	bsr	shxtobn			# get hexa number - trans to bin
	cmpqb	mem_gp,gptbl[r2:d]	# is it memory address ?
	beq	stu3
	checkb	r0,(gptbl+1)[r2:d],r1	# if reg num - check boundaries
	bfs	synterr		#       then goto synterr#
stu3:	movd	r1,stuadd(sb)	#   stuadd:=n
	movb	r2,stptype(sb)	#   stuadd.type:=r2
stu5:				# end ;
	movqd	3,r0		# for i:=1 to 3 do
stu6:	bsr	shxtobn		#     shxtobn (value) ;
	movd	r1,stuadd(sb)[r0:d]	#     stuadd[i]:=value
	acbb	-1,r0,stu6	# end ;
	movb	r3,stepflg(sb)	# stepflg:=stu or stw
	sbitd	$psr_t,svpsr(sb)# psr_t:=1 (* set trace bit *)
	br	stdgo

 #
 #
 #	l o a d    c o m m a n d
 #

loadlp:
	bsr	shxtobn		# shxtobn (addr) # {on error go to synterr}
	movqd	0,r3		# crc:=0;
lod1:	cmpd	r5,inlm(r7)	# repeat
	bge	synterr		# if dtrm.scn<=dtrm.inlm goto synterr
	cmpb	0(r5),$'*'	# if * then fast load
	beq	fload
	adjspb	$8
	movd	r5,tos		# hxtobn (x,exitf,dtrm.scn,dtrm.scn+1);
	addr	1(r5),tos
	bsr	hxtobn
	movd	tos,r5		# update dtrm.scn
	cmpqd	true,tos	# r2:=x
	movd	tos,scrch2(sb)	# if exitf goto synterr
	movb	scrch2(sb),r2
	beq	synterr	
	cmpb	0(r5),$cr	# if m(dtrm.scn = cr end of repeat
	beq	lodend		# else
	MOVSUB	scrch2(sb),0(r1)	#   m(addr)=x;
				#    if m(addr)<>x then goto vrferr
	MOVUSB	0(r1),scrch2(sb)
	cmpb	r2,scrch2(sb)
	bne	vrferr
	addqd	1,r1		#   addr:=addr+1;
	addb	r2,r3		#   crc:=crc+x;
	br	lod1		# until m(dtrm.scn)=cr
lodend:	cmpb	r3,r2		# if crc:=x then
	bne	crcerr		#    return
	br	mainlp
crcerr:	movd	$ecrc,r1		# else error (crc)
	br	erent
vrferr:	movd	r1,r0		# r0 := address of verification.
vrferr1: movd	$evrf,r1	# error (vrf)
	br	erent

 #
 #  fast load
 #

fload:	movd	r1,r0		# r0 := address of first byte to load
	addqd	1,r5		# skip the *
	bsr	shxtobn		# r1 := number of char to be read n
	cmpw	$0x100,r1	# id n > 256 error
	blt	synterr
	movb	$10,r3
flod1:	movqw	true,tos	# for i := 1 to 10 do
	movzbw	ndtrm(sb),tos	#  begin
	bsr	rdchr		#    rdchr (true,char,ndtrm) ; read char & wait
	cmpqb	0,tos
	cmpb	cntrll(sb),tos	#    if char = cntrl/l go to load2;
	beq	flod2
	acbb	-1,r3,flod1	#  end;
	br	synterr		# no cntrl/l after 7 chars error
flod2:	movb	ophnd(sb),r3	# save handshake flags
	movqb	0,ophnd(sb)
	movqb	pndmod,mon_usr(sb)	# hold interrupts until end of read
	movw	r1,tos
	addqw	1,tos		# read cntrl/l too
	movzbw	ndtrm(sb),tos	# rdlin (n,ndtrm,term1);
	addr	term1(sb),tos	#  {max buffer read is 256}
	bsr	rdlin
	adjspb	$-2		# *** ignore the return values
	movb	r3,ophnd(sb)	# reload ophnd
	movqb	mont,mon_usr(sb)
	cmpb	cntrll(sb),term1(sb)[r1:b]
	bne	synterr		# if last byte <> cntrl/l error
	movqd	0,r3		# for i := 1 to n do
flod4:	MOVSUB	term1(sb)[r3:b],0(r0)
	MOVUSB	0(r0),scrch2(sb)	#   adr^ := term1[i]
	cmpb	term1(sb)[r3:b],scrch2(sb)#   if  adr^ <> term1[i] verify error
	bne	vrferr1
	addqd	1,r0
	addqd	1,r3		#  end;
	cmpw	r3,r1
	blt	flod4
flod6:	cmpqb	true,pndf(sb)	# if pending_interrupt then
	bne	mainlp		#   go to pnd error
	movd	$epnd,r1		# else go to main loop
	br	erent
 
 #
 #  begin fast load in new protocol
 #

pfload:
	movqb	0,fldfrm(sb)	# reset fast load frame flag
	movd	r7,r5
	cmpb	cntrlb(sb),0(r5)# skip over the control b if there
	bne	pfld1
	addqd	1,r5
pfld1:	movd	0(r5),r0	# load addr
	movw	4(r5),r1	# no. of data bytes
	addd  	$8,r5		# data bytes start from byte 11 in record
pfld2:	MOVSUB	0(r5),0(r0)
	MOVUSB	0(r0),scrch2(sb)#   adr^ := term1(sb)[i]
	cmpb	0(r5),scrch2(sb)#  if adr^<>term1(sb)[i] verify error
	bne	vrferr1
	addqd	1,r0
	addqd	1,r5		#  end;
	acbw	-1,r1,pfld2
	br	mainlp
 # $$$ end

 #
 #
 #	d u m p    c o m m a n d
 #

litr1:	.ascii	"TR1 "
litr2:	.ascii	"TR2 "
 #
	.set	dmlin,32		# number of byte in a line
 #
mdumplp:
	movb	ndtrm(sb),r4	# term:=ndtrm
	cmpd	litr1,0(r5)	# if m(ndtrm.scn) = "tr1 "
	bne	mdu2		# then
	movqb	0,r4		#   term:=0
	br	mdu4		#   dtrm.scn:=dtrm.scn+4;
mdu2:	cmpd	litr2,0(r5)	# else
	bne	mdu5		#    if m(dtrm.scn) = "tr2 "
	movqb	1,r4		#    then  term:=1;
mdu4:	addqd	4,r5		#	   dtrm.scn:=dtrm.scn+4;
mdu5:				# end; if
	bsr	shxtobn		# hxtobn(addr1);
	movd	r1,r2		# {r2:=addr1}
	cmpb	0(r5),$'*'	# if * then fust dump
	beq	fdump
	bsr	shxtobn		# shxtobn(addr2);
mdulin:				# repeat
	movqd	0,r3		#   crc:=0;
	addr	term1(sb),r6	#   outb:=term1.outb
	cmpqb	0,r4		#   if term <> term1
	beq	mdul3		#   then outb:=term2.outb
	addr	term2(sb),r6
mdul3:	movd	r6,tos			# {push start addr of print 
					#  array for printa}
	movd	crl,0(r6)	#   outb(outlm):= $cr,lf,"l";
	addqd	3,r6		#   outlm:=outlm+3;
	movd	r2,tos		#   bntohx(addr1,8,2);
	movw	$0x802,tos
	movqw	0,tos		# *** align
	bsr	bntohx
	movb	$space,0(r6)	#   outb(outlm):=space;
	addqd	1,r6		#   outlm:=outlm+1
	movzwd	$dmlin,r0	#   $$$ l := nlin {# of bytes in a line}
	cmpd	r1,r0		#   if n<nlin
	bge	mduloop		#   then l := n;
	movd	r1,r0
				#   for i=1 to l do
mduloop: MOVUSB	0(r2),scrch2(sb)
	movzbd	scrch2(sb),tos
	addb	0(r2),r3	#      crc:=crc+m(addr1);
	addqd	1,r2		#      addr1:=addr1+1;
	movw	$0x200,tos	#      bntohx(m(addr1),2,0);
	movqw	0,tos		# *** align
	bsr	bntohx
	addqd	-1,r1		#      n := n-1;
	acbd	-1,r0,mduloop	#   end#   {for}
	movzbd	r3,tos		#   bntohx(crc,2,0);
	movw	$0x200,tos
	movqw	0,tos		# *** align
	bsr	bntohx
	movd	r6,tos		#   {parameters for printa}
	movzbd	r4,tos
	cmpqd	0,r1		#   if n=0
	beq	mduext		#   then goto duext;
	bsr	printa		#   printa (outb(1),outb(outlm),term,ophnd)
	br	mdulin		# until addr1>addr2
mduext:	movb	$cr,0(r6)	# outb(outlm):= cr ;
	addqd	1,4(sp)		# printa (outb(1),outb(outlm+2),term);
	bsr	printa
	br	mainlp

 #
 #  fast dump
 #

fdump:  addqd	1,r5
	bsr	shxtobn		# r1 := number of bytes to dump   n
	cmpw	r1,$0x100	# if n>256 error
	bgt	synterr
	movb	cntrll(sb),term1(sb)	# start the message with cntrl/l
	movqd	0,r3		# for i := 1 n do
fdu1:	MOVUSB	0(r2),term1+1(sb)[r3:b]
	addqd	1,r2		#    term1[i] := adr^.[i]
	addqd	1,r3		# end;
	cmpw	r3,r1
	blt	fdu1
	movb	cntrll(sb),term1+1(sb)[r3:b] # end message with cntrl/l
	movqb	pndmod,mon_usr(sb)	# delay all interrupts
	movb	ophnd(sb),r3	# save hand_shaking flag
	movqb	0,ophnd(sb)	# diable hand-shaking
	addr	term1(sb),tos
	addr	term1+2(sb)[r1:b],tos# printa (adr,adr+n,term);
	movzbd	r4,tos
	bsr	printa
	movqb	mont,mon_usr(sb)
	movb	r3,ophnd(sb)	# reload ophnd
	br	flod6
 
 #
 #
 #   m o v e    f i l l    s e a r c h   c o m m a n d s
 #
	.set	movc,0		# # of move command
	.set	srchc,2		# # of srch command
 #
optb:	.ascii	"B W D "	# b w d and v options search table
	.set	optbl,(.-optb)/2	# option table length
bcom:	.byte	3,2,0		# begin word for each command
 #
movelp:
fillp:
srchlp:
	addr	(-movc)(r2),r4	# l:=command number (0 move 1 fill 2 srch
	bsr	shxtobn		# shxtobn (addr1);
	movd	r1,r0		# r0:=addr1
	bsr	shxtobn		# shxtobn(addr2);
	movd	r1,r3		# r3:=addr2;
	bsr	shxtobn		# shxtobn(addr3)
	movd	r1,scrch2(sb)	#  save fill & search data to memory
	addr	optb,tos	# tbsrch(optb,3);
	movzbd	$3,tos
	bsr	tbsrch
	cmpqb	0,tos		# *** ignore return value
	cmpb	0(r5),$'N'	# if inbuf(dtrm.scn)="n"
	bne	spc5		# then no-verify bit:=true;
	orb	$4,r2
spc5:	ashd	$2,r2		# end if
	orb	bcom[r4:b],r2
	cmpqb	movc,r4		# if move command
	bne	spc9		# then
	movd	r0,r5		#    r5:=addr1;
	movd	r3,r0		#    addr1:=addr2;
	addd	r1,r3		#    addr2:=addr1+n-1;
	addqd	-1,r3		# else
spc9:	movb	r2,scrch1(sb)	# {save case word}
	andb	$0x0f,r2
				# for i:= 1 to n do
				# begin
spcl:	movqd	1,tos		#   step:=1;

 #
 #  case branch table
 #

spcs:	casew	spcbtb[r2:w]	#    case of (optword and v bit)
spcbtb:	.word	srchb-spcs	# srch  b
	.word	serr-spcs	# not exists
	.word	fillb-spcs	# fill  b
	.word	moveb-spcs	# move  b
	.word	srchw-spcs	# srch  w
	.word	serr-spcs	# not exists
	.word	fillw-spcs	# fill  w
	.word	serr-spcs	# move  w
	.word	srchd-spcs	# srch  d
	.word	serr-spcs	# not exists
	.word	filld-spcs	# fill  d
	.word	serr-spcs	# move  d
moveb:	MOVUSB	0(r5),scrch2(sb)	#     "b"  x:=m(source-addr)
	addqd	1,r5		#	   source-addr:=source-addr+1;
fillb:	MOVSUB	scrch2(sb),0(r0)	#	   m(destinatin-addr):=x;
srchb:
	MOVUSB	0(r0),-4(sp)
	cmpb	scrch2(sb),-4(sp)
spcf:	tbitd	$4,scrch1(sb)
	bfs	spcrp		#	  if f then
	beq	spc10		#	    if m(destination-addr)<>x then
	cmpqb	srchc,r4	#	     if not srch command
	bne	vrferr1		#	      then goto vrferr;
	br	spcrp
spc10:	cmpqb	srchc,r4	#	    else
	bne	spcrp		#	     if srch command then
	movb	$'=',0(r6)	#	      begin
	addqd	1,r6		#		dtrm.outb:= "=";
	movd	r0,tos		#		dtrm.outlm:=dtrm:outlm+2;
	movw	$0x602,tos	#		bntohx (destenatin-addr,6,2);
	movqw	0,tos		# *** align
	bsr	bntohx
	br	msgent		#		sprinta; return to mainlp;
				#	      end;
				#	   end;
spcrp:	addd	tos,r0		#	   destination-addr:=destination+step
	cmpd	r0,r3		# end for
 #	ble	spc1			# *K* this is a signed comparrison *K*
	bls	spcl			# *K* do UNSIGNED comparisson      *K*
	cmpqb	srchc,r4	# if not srch command then return to mainlp
	beq	sperr		# else
	br	mainlp
sperr:	movd	$esrc,r1	#  error (src);
	br	erent
fillw:	addqd	1,0(sp)		#	   step:=step+1;
	MOVSUW	scrch2(sb),0(r0)	#    "w"    m(destination-addr):=x
srchw:
	MOVUSW	0(r0),-4(sp)
	cmpw	scrch2(sb),-4(sp)
	br	spcf
filld:	addqd	3,tos		#	     step:=step+3;
	MOVSUD	scrch2(sb),0(r0)	#     "d"    m(destination-addr):=x;
srchd:
	MOVUSD	0(r0),-4(sp)
	cmpd	scrch2(sb),-4(sp)
	br	spcf
serr:	br	synterr
 
 #
 #
 #	 o p e r a t i n g      m o d e   c o m m a n d
 #

omtbl:  .byte   'N','T','B','L','S','Q'
omtcn:  .byte   0,0x3c,2,12,0x13,0x11   # default values

opcc:
#ifdef	ETHER	
	cmpqb   3,ackflg(sb)	#Config command are not valid on ethernet
	beq	synterr		
#endif
	cmpb	0(r5),$cr	# if cr go to main loop
	beq	mainlp
	cmpd	r5,inlm(r7)	# if dtrm.scn > inbuf.lm then error
	bgt	serr
	cmpb	0(r5),$space	# if 0(r5) = space then
	bne	op1		#   r5 := r5 + 1;
	addqd	1,r5
	br	opcc
op1:    movqb   6,r2            # for i := 1 to 6 do
op2:	cmpb	0(r5),(omtbl-1)[r2:b] # begin
	beq	op3		#     if 0(r5) = optable[i] go to op3
	acbb	-1,r2,op2	#   end;
	br	serr		# if no match error
op3:	movb	(omtcn-1)[r2:b],r1	# r1 := defult value
	addqd   1,r5		# next char
	cmpb	0(r5),$space	# if 0(r5) = space or cr go to opcase
	beq	opcase
	cmpb	0(r5),$cr
	beq	opcase
	cmpb	0(r5),$'='	# else if 0(r5) = '=' read value to r1
	bne	serr		# else error;
	addqd	1,r5		# skip the '='
	bsr	shxtobn
opcase: casew	(opct-2)[r2:w]
opct:	.word	opn-opcase
	.word	opt-opcase
	.word	opblsq-opcase
	.word	opblsq-opcase
	.word	opblsq-opcase
	.word	opblsq-opcase
opn:	movqb	stalon,opmod(sb)	# opmod := stand alone;
	br	opt2
opt:	movqb	transp,opmod(sb)	# opmod := transparent
opt2:	movb	r1,ophnd(sb)		# hand-shake flag := r1
	br	opcc
	

opblsq:
	movb	r1,cntrlb-3(sb)[r2:b]
	br	opcc

 #
 #
 #	 r e s e t    i n t b a s e
 #

rstintl: 
#ifndef	RAM
	lprd	intbase,rstint(sb)	# load initbase with reset value
	sprd	cfg,r3
	cbitd	$cfg_de,r3
	lprd	cfg,r3
#endif
newbrk:	br	mainlp


 #
 #
 #
 #	c a c h e	i n v a l i d a t e
 #

cacheinv:
	cmpb	0(r5),$space	# if 0(r5) = space then
	bne	caiv1		#   r5 := r5 + 1;
	addqd	1,r5
	br	cacheinv

caiv1:
	cmpb	0(r5),$'I'	# is it instruction cache inv?
	bne	caivd1		# no invalidate data cache.
caivc1:
	addqd	1,r5
	cmpb	0(r5),$space
	beq 	caivc1
	cmpb	0(r5),$'A'	# if A or E invalidate cache.
	beq	caivc2
	cmpb	0(r5),$'E'
	bne	synterr
caivc2:
        sprd    cfg,tos               	#
	tbitb	$11,0(sp)
	bfc	mainlp
	cbitb	$11,0(sp)
	lprd	cfg,0(sp)
	sbitb	$11,0(sp)
	lprd	cfg,tos
	movd	  0(sp),r3
	cbitb	$11,0(sp)
	lprd	cfg,tos
	br	mainlp
caivd1:
	cmpb	0(r5),$'D'	# data cache invalidation?
	bne	synterr		
caivd3:	addqd	1,r5
	cmpb	0(r5),$space
	beq 	caivd3
	cmpb	0(r5),$'A'
	beq	caivd2
	cmpb	0(r5),$'E'
	bne	synterr
caivd2:
        sprd    cfg,tos               	#
	tbitb	$9,0(sp)
	bfc	mainlp
	cbitw	$9,0(sp)
	lprd	cfg,0(sp)
	sbitb	$9,0(sp)
	lprd	cfg,tos
	movd	0(sp),r3
	cbitw	$9,0(sp)
	lprd	cfg,tos
	br	mainlp


 #
 #	d i r e c t	e x c e p t i o n
 #

exceptd:
#ifndef RAM
	cmpb	0(r5),$cr
	beq	synterr
sexcep:	cmpb	0(r5),$space
	bne	excep1	
	addqd	1,r5
	br	sexcep
excep1: cmpb	0(r5),$'E'
	beq	direxp
	cmpb	0(r5),$'D'
	bne	synterr
	cbitd	$cfg_de,svcfg(sb)	# clear de bit in saved cfg
        lprd    cfg,svcfg(sb)
	addr	inttab,r1		# get direct exception intbase value
	br	exexp
direxp:	
        sbitd	$cfg_de,svcfg(sb)	# set de bit in saved cfg
        lprd    cfg,svcfg(sb)
	addr	dinttab,r1		# get direct exception intbase value
exexp:	lprd	intbase,r1		#  load intbase reg with new value
#endif
	br	mainlp	

 # $$$ begin
 # 
 #  	change communication protocol commands
 #

newprot:
	cmpqb	1,protoc(sb)		# new protocol already?
	beq	mainlp			# yes, ignore
	movqb	1,prot_chng(sb)		# change to new protocol
	br	mainlp
 #
oldprot:	
	cmpqb	0,protoc(sb)		# old protocol already?
	beq	mainlp			# yes, ignore
	movqb	1,prot_chng(sb)		# change to old protocol
	br	mainlp
 #
 #	
 #	begin and end of fast downloading
 #
blcmd:
	movqb	1,profld(sb)
	br	mainlp
 #
elcmd:	movqb	0,profld(sb)
	br	mainlp

#ifdef monlx32
  #
  #  user call diagnostic
  # T  => run diagnostic once
  # T1 => run diagnostic in loop

diagcom:  
#ifndef	RAM
	br 	diagnos
#else
	br	mainlp
#endif
 
#endif monlx32

#ifdef mon532
 #
 # $$$ end
 #
 #	r u n	d i a g n o s t i c	t e s t s
 #
testd:
	br	diagnos
 # boot command
bootcmd: 	br mainlp
 #

#endif 
verhd:
#ifdef monlx32
	.ascii	" GNX MONGX32E 4.2 creation time:"
#endif monlx32
#ifdef mon532
	.ascii	" GNX MON532 4.2 creation time:"
#endif
#ifdef  mon32gx
	.ascii	" GNX MONGX32 4.2 creation time:"
#endif mon32gx
#ifdef mongx320
	.ascii	" GNX MONGX320 4.2 creation time:"
#endif

	.byte	0
	.globl	_date
version:
	addr    verhd,r0
verlp1:
	cmpb	0(r0),$0
	beq	vers1
	movb	0(r0),0(r6)
	addqd	1,r0
	addqd	1,r6
	br	verlp1
vers1:
	movd	_date,r0
verlp2:
	cmpb	0(r0),$0
	beq	vers2
	movb	0(r0),0(r6)
	addqd	1,r0
	addqd	1,r6
	br	verlp2
vers2:
	bsr	sprinta
	br	mainlp
	
	
	
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
 #     m o n i t o r    s p e c i a l    s u b r o u t i n e s
 #
 #
 #    s r d l i n     (standard read line procedure )
 #
 #
	.set	linlim,inlm	# max number of characters in input line

srdlin:
        enter   [r0,r1,r2],0            # for clean interface to C
	cmpqb	stalon,opmod(sb)# if opmod=transparent
	beq	srdlin2		# then
	bsr	transr		#   transr;
	addr	inbuf(r7),r5	#   dtrm.scn:=1;
	br	pckpro		# $$$ else
srdlin2:
	movw	$-linlim,tos	
	movzbw	ndtrm(sb),tos	#   rdlin (-linlim,ndtrm,inbuf)
	addr	inbuf(r7),tos			
	bsr	rdlin
	addr	inbuf(r7),r5	#   dtrm.scn :=1
	movzwd	tos,inlm(r7)
	addd	r5,inlm(r7)	#   dtrm.inlm:=rdn
 # $$$ begin
 #
 # strip off the packet if necessary 
 #

	cmpb	cntrlb(sb),0(r5)
	bne	pckpro
	addqd	1,r5		# skip over cntrl b in standaside mode
pckpro:
	movb	0(r5),curfrm(sb)# save current frame number
	cmpqb	timeout,proerr(sb) # timeout?
	beq	lwrext
	cmpqb	0,protoc(sb)	# old protocol?
	beq	lwrlp
	movqb	0,proerr(sb)	# no protocol error
pck04:
	cmpqb	0,fldfrm(sb)	# fast download frame?
	beq	pck04a
	movzwd	7(r5),r2	# no of data bytes in frame
	addd	$8,r2		# plus addr and length info bytes
	movd	r5,r1
	addqd	3,r1
	br	pck06
pck04a:	adjspb	$8		# changed to 8 from 5
	addr	1(r5),tos	# convert bytes 2,3 to binary
	addr	2(r5),tos	
	bsr	hxtobn
	movd	tos,r1		# end addr 
	cmpqd   true,tos	# illegal char in length field?
	movd	tos,r2  	# command length 
	addr	3(r5),r0	# this should point past the length field
	cmpd	r1,r0		# length field ok?
	beq	pck06
	movqb	3,proerr(sb)	# length field error
	br	lwrext
pck06:  addqb	3,r1
	addd	r2,r1		# this should be the end of the command
	cmpd	inlm(r7),r1	# is the input line this long?
	bge	pck08
	movqb	4,proerr(sb)	# command too short
	br	lwrext
pck08:				# calculate crc
	movd	r2,r1		# crc from frame number to end of command
	addqw	3,r1
	movw	r1,tos		# number of bytes
	addr	0(r5),tos 	# starting address
	bsr	calcrc
	movd	tos,r1		# should point to crc field
	movw	tos,r0		# crc calculated		 
	adjspb	$8		# changed to 8 from 5
	movd	r1,tos		# convert crc field to binary
	addqd	3,r1
	movd	r1,tos	
	bsr	hxtobn
	movd	tos,r1		# end addr 
	cmpqd	true,tos	# illegal char in crc field?
	movd	tos,r1  	# crc received 
	bne	pck10
	movqb	5,proerr(sb)	# illegal char in crc field		
	br	lwrext
pck10:	cmpw	r0,r1		# compare computed crc to received crc
	beq	pck12
	movqb	6,proerr(sb)	# crc error
	br	lwrext
pck12:				# good packet received
	movd	r5,r0
pck14: 	movb	3(r0),0(r0)	# strip off the frame info
	addqd	1,r0
	acbd	-1,r2,pck14
	movb	$cr,0(r0)	# terminate command with a cr
	cmpqb	1,fldfrm(sb)	# fast download frame?
	beq	lwrext		# yes, do not touch data
 # $$$ end

 #
 #  turn all lower case letters in command line to upper
 #

lwrlp:	movd	r5,r0		# for i := 1 to n {nuber of bytes read}
lwr0:	checkb	r1,lwrcb,0(r0)  #   begin
	bfs	lwr1		#     if inbuf [i] <= 'a' <= 'z'
	subb	$'a'-'A',0(r0)	#       then inbuf [i] := inbuf [i]-'a'+'a'
lwr1:	cbitd	$7,0(r0)	#       mask out bit 7
	addqd	1,r0		#   end
	cmpd	r0,inlm(r7)
	blt	lwr0
lwrext:	exit	[r0,r1,r2]	
	ret	0
lwrcb:	.byte	'z','a'		# limits of upper and lower letters

 #
 # $$$ begin
 # calculate crc of a string - called by pushing byte count and 
 #   starting address into stack.
 #   return with pointer to rest of string and crc on stack.
 #  
	.set	crcptr,8	# char ptr (dw)
	.set	crccnt,12	# byte count (w)
	.set	crcval,12	# crc value returned
	.set	crcpoly,0x1081	# crc polynomial
 #

calcrc:	enter	[r0,r1,r2,r3],0
	movd	crcptr(fp),r2	# char ptr
	movqd	0,r3		# set crc to 0
crclp:	movxbd	0(r2),r0	# c
	xord	r3,r0		# crc^c
	andd	$0xf,r0		# q = (crc^c)&0xf
	muld	$crcpoly,r0	# q*0x1021
	ashd	$-4,r3		# crc>>4
	xord	r0,r3		# crc = (crc>>4)^(q*0x1021)
	movxbd	0(r2),r0	# c
	lshd	$-4,r0		# c>>4
	xord	r3,r0		# crc^(c>>4)
	andd	$0xf,r0		# q = (crc^(c>>4))&0xf
	muld	$crcpoly,r0	# q*0x1021
	ashd	$-4,r3		# crc>>4
	xord	r0,r3		# crc = (crc>>4)^(q*0x1021)
	addqd	1,r2		# increment char ptr
	acbw	-1,crccnt(fp),crclp	# loop until byte count=0
 #
	movd	r2,crcptr(fp)	# return current pointer on stack
	movw	r3,crcval(fp)	# return crc on stack
	exit	[r0,r1,r2,r3]	
	ret	0
 
 #
 # $$$ end
 #
 #
 #    r d l i n       ( read lin procedure  )
 #
 #  local constants
 #

	.set	endlin,cr	# end of line character
	.set	delete,8	# back space character

 #
 #  arguments definitions
 #

	.set	rdn,14		# rdn : integer*2 max # of bytes
	.set	rdtrm,12	# rdtrm : integer*1 terminal ;
	.set	rdvec,8		# var rdvec : char[1..rdn]
 #

rdlin:
	enter	[r1,r2,r3],0
#ifdef ETHER
        cmpqb   3,ackflg(sb)            # if ackflg(sb) == 3 (Ethernet)
        bne     rd_serial:b             # then call Eread(& buf, +-size)
	cmpqb	0,force_serial(sb)	# if force-serial-link is used
	bne	rd_serial		#   then go use the serial link
        movxwd  rdn(fp),tos             # number of char to read.
        movd    rdvec(fp),tos           # poniter to buffer
        bsr     _Eread                  # call ethernet read
        adjspb  $-8
        movw    r0,rdn(fp)              # return number of char 
        exit    [r0,r1,r2]
        ret     6
rd_serial:
#endif ETHER

	movqb	false,r1		# readlnf:=false
	cmpqw	0,rdn(fp)		# if rdn<= then
	ble	rdlina			# begin
	movqb	true,r1			#   readlnf:=true;
	negw	rdn(fp),rdn(fp)		#   rdn:=-rdn;
					# end
rdlina:	movqd	0,r2			# n:=0
	br	rdold
rdlin1:	
	cmpqb	$0,protoc(sb)		# is it old protocol?
	bne     rdnew			# no, read wait until timeout
rdold:
	movqw	true,tos		# yes, wait forever
	br	rd1stc
rdnew:
	movqw	2,tos			# {rdchr (chr,timeout,rdtrm)}
rd1stc:
	movzbw	rdtrm(fp),tos
	bsr	rdchr
	adjspb	$-1			# {remove endf}
	movb	tos,r3			# chr:=rdchr (false,rdtrm);
	cmpqb	timeout,proerr(sb)	# timeout?
	beq	rdlinex			# yes, exit
	movzbd	rdtrm(fp),tos
	bsr	mdoecho			# mdoecho(chr,rdtrm)
	cmpb	$delete,r3		# if chr:=delete
	bne	rdlin2			#  then
	cmpqb	0,protoc(sb)		# is it old protocol?
	beq	rdo1
	cmpqb	1,fldfrm(sb)		#  if fast load frame
	beq	rdlin2			#  do not process delete
rdo1:
	cmpqb	true,r1			#   if readlnf
	bne	rdlin2			#    then
	cmpqd	0,r2			#     if n> 0
	bge	rdlin2			#	then
	addqd	-1,rdvec(fp)		#	  n:=n-1;
	addqd	-1,r2			# else
	br	rdlin1			# begin
rdlin2:
	cmpqb	true,svcpf(sb)		#    if called from svc then
	bne	rdlin3
	movb	r3,scrch2(sb)		#       vec(n) := chr; {movsu}
	MOVSUB	scrch2(sb),0(rdvec(fp))
	br	rdlin4			#    else
rdlin3:	movb	r3,0(rdvec(fp))		#       vec(n) := chr   {mov}
	cmpqb	0,protoc(sb)		# old protocol?
	beq	rdlin4
 # $$$ begin
	cmpqb	0,profld(sb)		# fast download?
	beq	rdlin4
	cmpw	$3,r2
	bne	rdln3a
	cmpw	$0x3030,-1(rdvec(fp))	# zero length field?
	bne	rdlin4			# no
	movqb	1,fldfrm(sb)		# yes, set fast load frame flag
	movd	$10,timcnt(sb) 		# set data byte to ensure data 
					#   transparency in
			       # len & addr
	br	rdlin4
rdln3a: cmpqb	0,fldfrm(sb)		# fast load frame?
	beq	rdlin4			# no 
	cmpw	$11,r2			
	bne	rdln4a
	movw	-1(rdvec(fp)),timcnt(sb)# ~no of data bytes in frame
	comw	timcnt(sb),timcnt(sb)
	cmpw	-3(rdvec(fp)),timcnt(sb)
	beq	rdlin4
	movw	$4097,timcnt(sb)	# set to max length, wait for timeout
rdln4a:	addqw	-1,timcnt(sb)		# decrement data byte count
 # $$$ end
rdlin4:	addqd	1,rdvec(fp)		#    n:=n+1;
	addqw	1,r2			# end;
	cmpw	rdn(fp),r2		# until
	ble	rdlinex			#     (n>=rdn)
	cmpqb	true,r1			#   or (readlnf and (chr=endlin))
	bne	rdlin1
	cmpb	r3,$endlin
	bne	rdlin1
	cmpqb	0,protoc(sb)
	beq	rdlinex
 # $$$ begin
	cmpqb	0,fldfrm(sb)		# fast download frame?
	beq	rdlinex			# no, return
	cmpqw	0,timcnt(sb)		# yes, all data byte received?
	ble	rdlin1			# no, ignore cr
 # $$$ end
rdlinex:
	movw	r2,rdn(fp)		# rdlin:=n
	exit	[r1,r2,r3]
	ret	6

 #
 #    d o e c h o  ( ec_chr,ec_trm)
 #	ec-chr  input : byte in r3 {char to be echo}
 #	ec_trm  input : byte  {terminal number}
 #    function  - check if echob of this terminal on then echo
 #		 if ec_chr is back_space echo with space to
 #		 if ec_chr is cr and echolf bit on echo with cr lf
 #
	.set	ec_trm,8
 #
mdoecho: enter	[r1,r3],0
	movb	ophnd(sb),r1	# {save opmod of term in r1 bits 0..3}
	cmpqb	trma,ec_trm(fp)
	beq	ec2
	lshb	$-4,r1
ec2:	tbitd	$echob,r1	# if echo then
	bfc	ecex		# begin
ec3:	movqb	true,tos
	movb	r3,tos
	movzbw	ec_trm(fp),tos	#   prchr (ture,ec_chr,ec_trm)
	bsr	prchr
	cmpqb	true,tos	#   {adjast stack}
	cmpb	r3,$cr		#   if ec_chr=cr then
	bne	ec4
	tbitd	$echolf,r1	#     and echolf on
	bfc	ecex		#   then echo with lf
	movb	$lf,r3
	br	ec3
ec4:	cmpb	$delete,r1	#   if ec_chr=delete then
	bne	ecex		#   begin
	movb	$space,r3
	br	ec3		#     echo with spase
ecex:
	exit	[r1,r3]
	ret	4	
 
 #
 #
 #    r d c h r      ( dummy read char procedure )
 #
 #  procedure rdchr (wait,trm)
 # $$$ when rd_wait is set to 2, timeout will occur in approx. 6 seconds
 #

	.set	rd_chr,11		# procedure value
	.set	rd_wait,10		# wait/nowait flag
	.set	rd_trm,8		# terminal number
 #
#ifdef mon532
 #
rdchr:	enter	[r1,r2],0
	movd	$sr+duart_ch1,r1	# r1: address of trminal a
	cmpqb	trma,rd_trm(fp)		# if trminal_num<> 0 then
   	beq	rdchr2			# $$$
	movd	$duart_ch2+sr,r1	# r1: address of trminal b
rdchr2:	movd	$0x90000,r2		# $$$ set timeout count
rdchrlp:				# do while in_rdy=0 and rd_wait=true
	tbitd	$in_rdy,0(r1)		#   input in_rdy
	bfs	rdchr3	
 # $$$ begin
	cmpqb	true,rd_wait(fp)	# wait for input?
	beq	rdchrlp			# yes, loop forever.
	cmpqb	false,rd_wait(fp)	# wait until timeout?
	beq	rdchrex			# no, exit
	acbd	-1,r2,rdchrlp		# loop until timeout 
	movqb	timeout,proerr(sb)	# set timeout flag
	movqb	false,rd_wait(fp)	# no char received
	br	rdchrex
 # $$$ end
rdchr3:
	movb	iop-sr(r1),rd_chr(fp)	# rdchr:=usart data
	movqb	true,rd_wait(fp)	# rd_wait:=true
rdchrex:
	exit	[r1,r2]
	ret	2

#endif
#if (defined(mon32gx) || defined(mongx320) || defined (monlx32))

rdchr:	enter	[r1,r2],0
	addr	uart0,r1
	cmpqb	trma,rd_trm(fp)		# if trminal_num<> 0 then
   	beq	rdchr2		
	addr	uart1,r1
rdchr2:	
    movd	$0x400000,r2		# set timeout count
 #rdchr2:	movd	$0x90000,r2		# set timeout count
rdchrlp:				# do while in_rdy=0 and rd_wait=true
	tbitd	$in_rdy,u_lsr(r1)	#   input in_rdy
	bfs	rdchr3	
	cmpqb	true,rd_wait(fp)	# wait for input?
	beq	rdchrlp			# yes, loop forever.
	cmpqb	false,rd_wait(fp)	# wait until timeout?
	beq	rdchrex			# no, exit
	acbd	-1,r2,rdchrlp		# loop until timeout 
	movqb	timeout,proerr(sb)	# set timeout flag
	movqb	false,rd_wait(fp)	# no char received
	br	rdchrex
rdchr3:
	movb	u_rx_data(r1),rd_chr(fp)	# rdchr:=usart data
	movqb	true,rd_wait(fp)	# rd_wait:=true
rdchrex:
	exit	[r1,r2]
	ret	2


#endif 
#
 #
 #	 t r a n s p a r e n t     m o d e    r e a d
 # $$$ in command mode, timeout occurs if command is not terminated and
 # $$$ there is more than a 4 second gap in between chars
 #

	.set	svtrm2,-4		# svtrm2 : integer {term2 address}
	.set	svtrm1,-8		# svtrm1 : integer {term1 address}
	.set	trsc,-12		# trsc	: array of integer*1 {counters}
	.set	trscmd,-16		# trscom : array of boolean
 #

transr:	enter	[r1,r2,r6],14		# $$$
	movqd	0,trsc(fp)		# $$$ trsc[1]:=0; trsc[2]:=0;
	movqw	0,trscmd(fp)		# trscmd[1] := 0 trscmd[2] := 0
	addr	term1(sb),svtrm1(fp)	# svtrm1:=address of term1;
	addr	term2(sb),svtrm2(fp)	# svter2:=address of term2;
	movqd	0,r1			# term:=0
					# repeat
trs1:	xorb	$1,r1			#   term:=next term
trs2:	movqw	false,tos
	movzbw	r1,tos			#   rdchr (chr,false,endf,term);
	bsr	rdchr
	cmpqb	true,tos		#   {r2:=chr}
	movb	tos,r3			#   if endf then
 # $$$ begin
	beq	trs2a
	cmpqb	true,trscmd(fp)[r1:b]   # transparent command mode?
	bne	trs1			# no, look for input from another term
	cmpqb	0,protoc(sb)		# old protocol?
	beq	trs1
	acbw	-1,timcnt(sb),trs1	# yes, check for timeout
	movqb	timeout,proerr(sb)
	br	trs10
trs2a:
 # $$$ end

	cmpqb	true,trscmd(fp)[r1:b]	#     if not trscmd[term]
	beq	trs7			#     then
trs3:   cmpb    cntrlb(sb),r3		#	else
	bne	trs5			#	  if chr=control x then
	movqb	true,trscmd(fp)[r1:b]	#	      trscmd[term]:=true
	movw	$0xe000,timcnt(sb)	# $$$ set timeout constant
	br	trs1			#	    else
trs5:	xorb	$1,r1
	movqb	true,tos
	movb	r3,tos			#	      prchr(true,chr,next term)
	movzbw	r1,tos			#	end;
	bsr	prchr			#     end
	cmpqb	true,tos		#   {pop pr_ready}
	br	trs2			#   else
trs7:	movzbd	r1,tos			#     mdoecho (term,chr)
	bsr	mdoecho
	movw	$0xe000,timcnt(sb)	# $$$ set timeout constant
	movd	svtrm1(fp)[r1:d],r7	#     {r7:=pointer to term-buffer}
	cmpb	r3,$delete		#     if chr=delete then
	bne	trs9			#     begin
	cmpqb	1,fldfrm(sb)		# $$$ fast load frame?
	beq	trs9			# $$$ yes, do not touch data
	cmpqw	0,trsc(fp)[r1:w]	# $$$   if cont[term]>0
	bge	trs1			#       then
	addqd	-1,trsc(fp)[r1:w]	# $$$	  trsc[term]:=trsc[term]-1;
	br	trs1			#     end
trs9:	addr	inbuf(r7),r6		#     else
	movzwd	trsc(fp)[r1:w],tos	# $$$ begin
	addd	tos,r6			#	inbuf[term,trsc[term]]:=chr;
	movb	r3,0(r6)
	movd	r6,inlm(r7)		#	inlm[term]:=trsc[term];
 # $$$ begin
	cmpqb	0,profld(sb)		# fast download?
	beq	trs9a
	cmpw	$2,trsc(fp)[r1:w]	# length field?
	bne	trs9b
	cmpw	$0x3030,-1(r6)		# yes, zero length?
	bne	trs9a			# no, not fast load frame
	movqb	1,fldfrm(sb)		# yes, set fast load frame flag
	br	trs9a
	movd	$10,r2	       # set data byte to ensure data transparency in
			       # len & addr
trs9b:	cmpqb	0,fldfrm(sb)		# fast load frame?
	beq	trs9a			# no
	cmpw	$10,trsc(fp)[r1:w]	# length field received?
	bne	trs9c			# no
	movw	-1(r6),r2		# ~no of data bytes in frame
	comw	r2,r2
	cmpw	-3(r6),r2		# check for consistency of len
	beq	trs9a			# good
	movw	$4097,r2		# set to max length, wait for timeout
trs9c:	addqw	-1,r2			# decrement byte count for data
trs9a:	addqw	1,trsc(fp)[r1:w]	# 	trsc[term]:=trsc[term]+1;
	cmpw	$linlim,trsc(fp)[r1:w]	#      or (trsc[term]>linlim);
	ble	trs10
	cmpb	$endlin,r3		#     end;
	bne	trs1			# until (chr=endlin)
	cmpqb	0,fldfrm(sb)		# fast download frame?
	beq	trs10			# no, end of line
	cmpqw	0,r2			# yes, all data received?
	ble	trs1			# no, data transparent
 # $$$ end
trs10:	movd	r7,dtrm(sb)		# dtrm:=term {set default terminal}
	movb	r1,ndtrm(sb)
trsex:
	exit	[r1,r2,r6]
	ret	0

 #
 #  skip on space subroutine
 #

comp1:	addqd	1,r5			# dtrm.scn:=dtrm.scn+1;
comps:	cmpd	r5,inlm(r7)		# while drtm.scn<dtrm.inlm
	bge	compex
	cmpb	0(r5),$space		#   and inbuf(dtrm.scn):=space
	beq	comp1			#     dtrm.scn:=dtrm.scn+1;
compex:	ret	0			# end while
 
 #
 #
 #	p r i n t a
 #
 #	print array procedure
 #
 #	calling sequence printa (arrp,endp,prtrm)
 #	   arrp  - pointer to array to be printed
 #	   endp  - pointer to last byte to be printed
 #	   prtrm -  # of terminal to print on
 #	   hnd   - boolean flag if hand-shaking needed
 #
 #  local constants
 #
	.set	printe,0		 # end of line indicator
 #
	.set	arrp,16		# var: array of chr
	.set	endp,12		#  pointer
	.set	prtrm,8		#  integer [0..1]
 #

printa:	
#ifdef ETHER
        cmpqb   3,ackflg(sb)            # if ackflg(sb) == 3 (Ethernet)
        bne     pr_serial:b             # then call Eread(& buf, +-size)
	cmpqb	0,force_serial(sb)	# if force-serial-link is used
	bne	pr_serial		#   then go use the serial link
        enter   [r0,r1,r2],0            # for clean interface to C
        movd    endp(fp),tos            # end of buffer
        movd    arrp(fp),tos            # start of buffer
        bsr     _Ewrite                 # call Ethernet write.
        adjspb  $-8
        exit    [r0,r1,r2]
        ret     12
pr_serial:
#endif ETHER
        enter   [r1,r2,r3,r4,r5,r6],0
	movd	arrp(fp),r1		# r1:=pointer to print array
	movb	ophnd(sb),r2		# r2:= opmod [prtrm]
	cmpqb	trma,prtrm(fp)
	beq	prntlp
	lshb	$-4,r2
prntlp:
	cmpqb	true,svcpf(sb)		# if svcf then
	bne	prnx1
	MOVUSB	0(r1),scrch2(sb)	#    get next byte from user space
	movb	scrch2(sb),r4
	br	prnt2			# else
prnx1:	movb	0(r1),r4		#   get next char from supervisor space
prnt2:	movqb	false,r6		#   cnts_flage := 0
cnts1:	movqw	false,tos		#   rdchr(falsem,char,prtrm)read nowait
	movzbw	prtrm(fp),tos
	bsr	rdchr
	movb	tos,r5		#    {pop firtst argument }
	tbitd	$0,r5		#    f := char ready
	movb	tos,r5		#    r5 := char
	cmpqb	true,r6		#    if cnts_flag = false
	beq	cnts2		#      then
	bfc	prnx2		#	 if no char ready go to print
	cmpb	cntrls(sb),r5	#	else if char<> cntrls go to print
	bne	prnx2		#	      else
	movqb	true,r6		#		snts-flag := true
	br	cnts1		#		 go to read next char
cnts2:	bfc	cnts1		#    else if no char go to read char again
	cmpb	cntrlq(sb),r5	#	 else
	bne	cnts1		#	    if char <> cntrls go to read char
					#	   else end of /s/q go to print
#ifdef mon532
prnx2:	movb	$false,tos		# go to exit
#else
prnx2:	movb	$true,tos		# go to exit
#endif
	movb	r4,tos			#   prchr(true,m(arrp),prtrm)
	movzbw	prtrm(fp),tos
	bsr	prchr			#   {remove endf from stack}
	cmpqb	true,tos		# end
	bne	prnt2			# if output is still going on
prnx3:	cmpb	r4,$cr			# if (hand[prtrm] and m[arrp]=cr]
	bne	prnt8			# then
	tbitd	$handb,r2		# begin
	bfc	prnt5
	movqb	0,r3
precho:	movqw	2,tos			# $$$   rdchr (chr,false,rdtrm)
	movzbw	prtrm(fp),tos
	bsr	rdchr
	cmpqb	0,tos			#   {remove endf from stack}
	cmpb	$cr,tos
	bne	prnt4
	tbitd	$handlf,r2		#    if hnd[prtrm] wait to cr
	bfc	prnt5
	movqb	1,r3
	br	precho
prnt4:	cmpb	$lf,-1(sp)
	bne	precho			# end
	cmpqb	1,r3
	bne	precho
prnt5:	tbitd	$echolf,r2		# if echolf[prtrm] then
	bfc	prnt8			# begin
	movb	$lf,r4			#   echo with lf
	br	prnt2			# end;
prnt8:	addqd	1,r1
	cmpd	r1,endp(fp)		#  repeat untile arrp>endp
	bge	prtaex
	br	prntlp
prtaex:
	exit	[r1,r2,r3,r4,r5,r6]
	ret	12
 
 #
 #
 #	s p r i n t a
 #	standard call to printa procedure
 #	function - print output buffer of currently working terminal
 #	parameters - none
 #	local variables - none
 #	On entry:
 #		r7 points to terminal record
 #		r6 points to end of print message
 #

sprinta:
 # $$$ begin
	save	[r1,r2]
	cmpqb	$0,protoc(sb)	# old protocol
	beq	sprintb
 #
	cmpb	$'*',0(r7)	# is this the * line?
	beq	fframe		# yes, do not save this response
	movd	r7,r1		# save the response in case 
	addr	sresp(sb),r2	# retransmission is needed
srloop:	movb	0(r1),0(r2)
	addqd	1,r1
	addqd	1,r2
	cmpd	r1,r6
	bne	srloop	
	movqb	0,0(r2)		# terminate with a null
 #
fframe:
	movb	curfrm(sb),-3(r7)	# frame number
	subd	r7,r6		# get message length
	save	[r6]
	movd	r6,tos		# convert length to hex and put into buffer
 	addr	-2(r7),r6
	movw	$0x200,tos	# 2 hex digits for length
	movqw	$0,tos
	bsr	bntohx
	restore	[r6]
 #				# now calculate crc for message
	addqd	3,r6		# message + frameno + len fields
	movw	r6,tos		# number of bytes
	addr	-3(r7),tos 	# starting address
	bsr	calcrc
	movd	tos,r6		# should point to end of message 
	movw	tos,r0		# crc calculated		 
 #
	movd	r0,tos		# convert crc to 4 ascii digits
	movw	$0x400,tos			
	movqw	$0,tos
	bsr	bntohx
 #
	addr	-3(r7),tos
	br	sprintc
sprintb:
 # $$$ end
	addr	outb(r7),tos
sprintc:			
	movb	$cr,0(r6)		# append cr
	addqd	1,r6			# update pointer 
	movd	r6,tos			# printa (dtrm.outb,dtrm.outlm,dtrm)
	movzbd	ndtrm(sb),tos
	bsr	printa
	restore	[r1,r2]		
	ret	0
 
 #
 #
 #	p r c h r    ( print character )
 #	function - send one character to terminal
 #	calling sequence prchr(endf,wait,chr,trm)
 #       endf/wait	
 #		boolean  in/out on input flage wait to end of operation
 #				 or reurn
 #				 on output indicates end of operation
 #	chr  - character input  character to be printed
 #	trm  - integer   input  terminal number
 #
	.set	wait_pr,11		# wait : boolean
	.set	chr_pr,10		# ascii chr
	.set	trm_chr,8		# terminal number
 #

#ifdef mon532
prchr:	enter	[r1,r2],0
	movd	$duart_ch1+sr,r1		# r1: address of trminal a
	cmpqb	trma,trm_chr(fp)	# if trminal_num<> 0 then
	beq	prchrlp
	movd	$duart_ch2+sr,r1	# r1: address of trminal b
prchrlp:
	movb	$5,com-sr(r1)
	tbitd	$out_rdy,0(r1)		# if tx-rdy = 0
	bfs	prchr3			# then
	cmpqb	false,wait_pr(fp)	#   if wait then repeat
	bne	prchrlp
	br	prchrex			#   else wait:=false
prchr3:
	movb	chr_pr(fp),iop-sr(r1)
	movqb	true,wait_pr(fp)	# else write(data-port,chr)
prchrex:
	exit	[r1,r2]
	ret	3

#endif

#if	(defined(mon32gx) || defined(mongx320) || defined (monlx32))

prchr:	enter	[r1,r2],0
	addr	uart0,r1
	cmpqb	trma,trm_chr(fp)	# if trminal_num<> 0 then
	beq	prchrlp
	addr	uart1,r1
prchrlp:
	tbitd	$out_rdy,u_lsr(r1)	# if tx-rdy = 0
	bfs	prchr3			# then
	cmpqb	false,wait_pr(fp)	#   if wait then repeat
	bne	prchrlp
	br	prchrex			#   else wait:=false
prchr3:
 #	movb	r4,datap(r1)
	movb	chr_pr(fp),u_tx_data(r1)
	movqb	true,wait_pr(fp)	# else write(data-port,chr)
prchrex:
	exit	[r1,r2]
	ret	3

#endif
 
 #
 #
 #	h x t o b n  (hexa-decimal to binary)
 #

	.set	word_hb,20		# word_hb : dinteger
	.set	exrr_hb,16		# exrr : integer
	.set	vecp_hb,12		# vecp : var :pointer
	.set	endp_hb,8		# endp : pointer
 #
hxtobn:	enter	[r1,r3,r4],0
	movqd	0,r4			# word:=0
	movqd	true,exrr_hb(fp)	# exrr:= true
htblp:	addr	hexan+15,r1		# (* r1:= address hexan+16 *)
	movzbd	$16,r3			# i:=17 (* i in r3 *)
htb1:	cmpb	0(vecp_hb(fp)),0(r1)	# if m(vecp)<>hexan[i]
	addqd	-1,r3			# then
	beq	htbf1
	cmpqd	0,r3			#    if i=0 then exit
	beq	htbex
	addqd	-1,r1			#    else i:=i-1
	br	htb1
htbf1:	ashd	$4,r4
	addd	r3,r4			# word:=word*16+i
	movqb	false,exrr_hb(fp)	# exrr:=false
htb2:	addqd	1,vecp_hb(fp)		# vecp:=vecp+1
	cmpd	vecp_hb(fp),endp_hb(fp) # untile vecp>= endp
	ble	htblp
htbex:	movd	r4,word_hb(fp)
	exit	[r1,r3,r4]
	ret	4
hexan:	.ascii	"0123456789ABCDEF"

 #
 #
 #	b n t o h x   (binary to hex-decimal conversion)
 #
	.set	word_bh,12		# word : dinteger
	.set	n_bh,11		# n : integer
	.set	type_bh,10		# type : integer[0..2]
 #

bntohx:	enter	[r1,r2],0
bthlp:	movzbd	n_bh(fp),r2		# (* r2:=vecp *)
	cmpqd	0,r2			#  while n>0 do
	bge	bthex
	addqd	-1,r2
	ashd	$2,r2			# r2:=(n-1)*4 (* bit field *)
	extb	r2,word_bh(fp),r2,4	# r2:= n-th hexa digit of word
	cmpqb	0,r2
	bne	bth2			# if r2:=0 and n>1 then
	cmpqb	1,n_bh(fp)	
	beq	bth2
	cmpqb	1,type_bh(fp)		# case type of
	bgt	bth2			#   <1 put leading zeros
	blt	bth4			#   >1 supress leading zeros
	movb	$' ',0(r6)		#   =1 insert space for leading zeros
	br	bth3
bth2:	movb	hexan[r2:b],0(r6)	# m(vecp):=hexan[r2]
	movqb	0,type_bh(fp)
bth3:	addqd	1,r6			# vecp:=vecp+1
bth4:	addqb	-1,n_bh(fp)		# n:=n-1
	br	bthlp
bthex:
	exit	[r1,r2]
	ret	8
 
 #
 #
 #	t b s r c h  (table search procedure )
 #
	.set	tabadr,12		# tabaddr : pointer
	.set	length,8		# length : integer
	.set	exitf,15		# exitf : boolean
 #

tbsrch:	enter	[],0
	movqd	0,r2			# i:=0
					# repeat
srchl:	cmpw	0(tabadr(fp))[r2:w],0(r5)
	beq	srfnd			#  if tab(i_i+1)<>inbuf(i_i+1)
	cmpb	0(tabadr(fp))[r2:w],0(r5)# then if tab(i)=inbuf(i)
	bne	src2			#	    then
	cmpb	1(tabadr(fp))[r2:w],$space  #	if tab(i+1):=space
	beq	srfnd2			#		 goto found;
src2:	addqd	1,r2			#      else
	cmpb	r2,length(fp)		#	i:=i+1;
	blt	srchl			# until i=length;
	movqb	false,exitf(fp)		# exitf:=false;
	movqd	0,r2
	br	srchex
srfnd:	addqd	1,r5			# dtrm.scn:=dtrm.scn+1;
srfnd2:	addqd	1,r5			# dtrm.scn:=dtrm.scn+1;
	movqb	true,exitf(fp)		# exitf:=true
	bsr	comps			# comps  {compress space}
srchex:
	exit	[]
	ret	7
 
 #
 #
 #	g e t p u t     p r o c e d u r e
 #
 #	function - get register or memory value to r1
 #		   put register or memory value from r1
 #
 #		   register is one of :
 #		   pc,us,is,intb,sb,fp,mod,psr,dcr,dsr,car,bpc,eadd,pf,
 #		   sc,bpr,bcnt,sp,fl,fsr,r,f,fsr,cfg,soft-bpr
 #		   heap-start,heap-end,heap-pointer
 #
 #		   memory is : byte word double
 #
 #		   r2 contains register  # (or memory)
 #
 #	calling sequence getput (get_put,type,n,value)
 #	      getput -  0 get
 #			1 put
 #	      type   -	register type (in r2)
 #	      n      -	register number ( when more than one of that type)
 #	      value  -  value get (or put) in r1
 #	      gpsize -  size of return value.
 #
	#.set	geti,0			# get indicator
	.set	get_put,12		# get-put : integet [0..1]
	.set	n_gp,8			# n	  : dinteger
	#.set	temp,-4			# temporary
 #

getput:	enter	[r0,r3],4
 #	movqw	0,svmod+2(sb)		# clear un existing part of mod
	movd	n_gp(fp),r0
	movqd	0,r3
lgp:	casew	case_gp[r2:w]		# case of register type
case_gp: 
	.word	gppc-lgp	# pc 
	.word	gpus-lgp	# us
	.word	gpis-lgp	# is
	.word	gpin-lgp	# intbase
	.word	gpsb-lgp	# sb
	.word	gpfp-lgp	# fp
#ifdef mon532
	.word	gpmcr-lgp	# mcr
	.word	gpmmcr-lgp	# mmcr
	.word	gpmsr-lgp	# msr
	.word	gptear-lgp	# tear
	.word	gppt-lgp	# ptb
	.word	gpivar-lgp	# ivar
#endif mon32gx
	.word	gpsp-lgp	# sp
	.word	gpfsr-lgp	# fsr
	.word	gpcfg-lgp	# cfg
	.word	gphs-lgp	# heap start
	.word	gphe-lgp	# heap end
	.word	gphp-lgp	# heap pointer
	.word	gpdcr-lgp	# dcr
	.word	gpdsr-lgp	# dsr
	.word	gpcar-lgp	# car
	.word	gpbpc-lgp	# bpc
	.word	gpmod-lgp	# mod
	.word	gppsr-lgp	# psr
	.word	gpbrl-lgp	# soft-break
	.word	gpr-lgp		# r0-r7
	.word	gpf-lgp		# f0-f7
	.word	gpl-lgp		# l0-l7
	.word	gpmb-lgp	# memory byte
	.word	gpmw-lgp	# meory word
	.word	gpmd-lgp	# memory double

 #
 # get pu pc
 #
gppc:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	ppc
	movd	svpc(sb),r1	# get pc
	br	gpex
ppc:	movd	r1,svpc(sb)	# put pc
	br	gpex

 #
 # get put is
 #

gpis:	cmpqb	$geti,get_put(fp)
	bne	pis
	movd	svis(sb),r1	# get is
	br	gpex
pis:	movd	r1,svis(sb)	# put is
	br	gpex

 #
 # get put us
 #

gpus:	cmpqb	$geti,get_put(fp)
	bne	pus
	movd	svus(sb),r1	# get us
	br	gpex
pus:	movd	r1,svus(sb)	# put us
	br	gpex

 #
 # get put mod
 #

gpmod:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmod
	movd	svmod(sb),r1	# get mod
	br	gpex
pmod:	movd	r1,svmod(sb)	# put mod
	br	gpex

 #
 # get put psr
 #

gppsr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	ppsr
	movd	svpsr(sb),r1	# get psr
	br	gpex
ppsr:	movd	r1,svpsr(sb)	# put psr
	br	gpex

 #
 # get put sb relative
 #

gpsb:	cmpqb	$geti,get_put(fp)
	bne	psb
	movd	svsb(sb),r1	#get user sb
	br	gpex
psb:	movd	r1,svsb(sb)	#put user sb
	sprd	cfg, r0		#Check if in non direct exception mode
	tbitb	$cfg_de, r0
	bfs	gpex
	movd	r1, 0(svmod(sb))
	br	gpex

 #
 # get put fp
 #

gpfp:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp
	movd	svfp(sb),r1	# get fp
	br	gpex
pfp:	movd	r1,svfp(sb)	# put fp
	br	gpex

 #
 # get put dcr
 #

gpdcr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pdcr
        sprd    dcr,r1
	br	gpex
pdcr:	
#if (defined(mon32gx) || defined(monlx32) || defined (mongx320))
	sfsb	tos
	tbitb	$0,tos
	adjspb	$-1
#endif mon32gx
	lprd    dcr,r1
	br	gpex

 #
 # get put dsr
 #

gpdsr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pdsr
	sprd    dsr,r1
	br	gpex
pdsr:	
	lprd    dsr,r1	# put dsr
	br	gpex

 #
 # get put car
 #

gpcar:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pcar
	sprd    car,r1
	br	gpex
pcar:	
	lprd    car,r1
	br	gpex

 #
 # get put bpc
 #

gpbpc:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pbpc
	sprd    bpc,r1       
	br	gpex
pbpc:	
	lprd    bpc,r1
	br	gpex

 #
 # get put general purpose registers
 #

gpr:	movd	n_gp(fp),r0
	negd	r0,r0
	cmpqb	$geti,get_put(fp)
	bne	preg
	movd	svr0(sb)[r0:d],r1	# get register
	br	gpex
preg:	movd	r1,svr0(sb)[r0:d]
	br	gpex

 #
 # get put sp
 #

gpsp:	tbitd	$psr_s,svpsr(sb)# if psr_s then
	bfs	gpus		#    get put us
	br	gpis		#    get put is

 #
 # get put in
 #

gpin:	cmpqb	$geti,get_put(fp)
	bne	pin
	sprd	intbase,r1	#  r1 := intbase
	br	gpex		# else
pin:	lprd	intbase,r1	#    intbase := r1;
	br	gpex

 #
 # get put fpu data registers
 #

gpf:	movd	n_gp(fp),r0
gfpul:	casew	case_fp[r0:w]		#jump according to reg#
case_fp:
	.word	fp_0-gfpul
	.word	fp_1-gfpul
	.word	fp_2-gfpul
	.word	fp_3-gfpul
	.word	fp_4-gfpul
	.word	fp_5-gfpul
	.word	fp_6-gfpul
	.word	fp_7-gfpul
fp_0:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp0			# if get then
	movf	f0,tos			# get f0
	movd	tos,r1
	br	gpex			# return
pfp0:	movd	r1,tos
	movf	tos,f0	
	br	gpex			# return
fp_1:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp1			# if get then
	movf	f1,tos			# get f0
	movd	tos,r1
	br	gpex			# return
pfp1:	movd	r1,tos
	movf	tos,f1	
	br	gpex			# return
fp_2:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp2			# if get then
	movf	f2,tos			# get f0
	movd	tos,r1
	br	gpex			# return
pfp2:	movd	r1,tos
	movf	tos,f2	
	br	gpex			# return
fp_3:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp3			# if get then
	movf	f3,tos			# get f3
	movd	tos,r1
	br	gpex			# return
pfp3:	movd	r1,tos
	movf	tos,f3	
	br	gpex			# return
fp_4:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp4			# if get then
	movf	f4,tos			# get f4
	movd	tos,r1
	br	gpex			# return
pfp4:	movd	r1,tos
	movf	tos,f4	
	br	gpex			# return
fp_5:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp5			# if get then
	movf	f5,tos			# get f5
	movd	tos,r1
	br	gpex			# return
pfp5:	movd	r1,tos
	movf	tos,f5	
	br	gpex			# return
fp_6:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp6			# if get then
	movf	f6,tos			# get f6
	movd	tos,r1
	br	gpex			# return
pfp6:	movd	r1,tos
	movf	tos,f6	
	br	gpex			# return
fp_7:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfp7			# if get then
	movf	f7,tos			# get f7
	movd	tos,r1
	br	gpex			# return
pfp7:	movd	r1,tos
	movf	tos,f7	
	br	gpex			# return

 #
 # get put l regs
 #

gpl:
gplcs:	casew	gplr[r0:w]
gplr:
	.word	gpl0-gplcs
	.word	gpl1-gplcs
 	.word	gpl2-gplcs
	.word	gpl3-gplcs
 	.word	gpl4-gplcs
	.word	gpl5-gplcs
 	.word	gpl6-gplcs
	.word	gpl7-gplcs
 #l0
gpl0:	
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl0
	movl	l0,fpubuf(sb)
	br	gpex
pl0:    
	movl	fpubuf(sb),l0
	br	gpex
 # l1
gpl1:	
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl1
	movl	l1,fpubuf(sb)
	br	gpex
pl1:    
	movl	fpubuf(sb),l1
	br	gpex
 #l2
gpl2:	
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl2
	movl	l2,fpubuf(sb)
	br	gpex
pl2:    
	movl	fpubuf(sb),l2
	br	gpex
 #l3
gpl3:	
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl3
	movl	l3,fpubuf(sb)
	br	gpex
pl3:    
	movl	fpubuf(sb),l3
	br	gpex
 #l4
gpl4:
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl4
	movl	l4,fpubuf(sb)
	br	gpex
pl4:    
	movl	fpubuf(sb),l4
	br	gpex
 #l5
gpl5:
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl5
	movl	l5,fpubuf(sb)
	br	gpex
pl5:    
	movl	fpubuf(sb),l5
	br	gpex
 #l6
gpl6:
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl6
	movl	l6,fpubuf(sb)
	br	gpex
pl6:    
	movl	fpubuf(sb),l6
	br	gpex
 # l7
gpl7:	
	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pl7
	movl	l7,fpubuf(sb)
	br	gpex
pl7:    
	movl	fpubuf(sb),l7
	br	gpex
#ifdef mon532
 #
 # get put mmcr
 #
gpmmcr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmmcr
	smr	mcr,r1
	br	gpex
pmmcr:
	lmr	mcr,r1
	movd	r1,mnmcr(sb)
	br	gpex
 #
 # get put mcr
 #
gpmcr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmcr
	movd	svmcr(sb),r1
	br	gpex
pmcr:	movd	r1,svmcr(sb)
	br	gpex
 #
 # get put msr
 #
gpmsr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmsr
	smr	msr,r1
	br	gpex
pmsr:	lmr	msr,r1
	br	gpex
#endif 

 #
#ifdef mon532
 # get put tear
 #
gptear:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	ptear
	smr	tear,r1
	br	gpex
ptear:	lmr	tear,r1
	br	gpex
 #
 # get put ptb0,1
 #
gppt:	movd	n_gp(fp),r0
        cmpqd	$geti,get_put(fp)
	bne	pptb	
	cmpqb	$0,r0
	bne	gptb1
	smr	ptb0,r1
	br	gpex
gptb1:	
        smr	ptb1,r1
	br	gpex
pptb:	cmpqb	$0,r0
	bne	pptb1
	lmr	ptb0,r1
	br	gpex
pptb1:	lmr	ptb1,r1
	br	gpex
 #
 # get put ivar0,1
 #
gpivar:	movd	n_gp(fp),r0
        cmpqd	$geti,get_put(fp)
	beq	givar	
	cmpqb	$0,r0
	bne	pivar1
	lmr	ivar0,r1
	br	gpex
pivar1:	lmr	ivar1,r1
	br	gpex
givar:
	movd	$true,ivflg(sb)		# illegal command
	br 	gpex
 #
 #
#endif 
 #  get put cfg
 #

#if (NOMMU)
	.set	no_mmubit, 0x03ffb	#32GX32 has NO mmu (bit 2 of cfg)
#endif 

gpcfg:	cmpqb	$geti,get_put(fp)	# (* set cc if operation is get *)
	beq	gcfg			# if getput=put then
#if (NOMMU)
	andd	$no_mmubit, r1		#  reset mmu enable bit if set
#endif 
	lprd    cfg,r1
	sprd    cfg,svcfg(sb)
	br	gpex
gcfg:   				# else
	sprd    cfg,r1
	br	gpex

 #
 #  get put fsr
 #
 #

gpfsr:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pfsr			# if get then
	sfsr	tos			#   move fsr to stack
	movd	tos,r1			
	br	gpex
pfsr:	movd	r1,tos			# move r1 to fsr via stack
	lfsr	tos
	br	gpex
 
 #
 #
 #  get put memory
 #

gpmb:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmb
	movd	$0,scrch2(sb)
gb:	MOVUSB	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
	br	gpre1
pmb:	movd	r1,scrch2(sb)
	MOVSUB	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gpex
 #
gpmw:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmw
	movd	$0,scrch2(sb)
	MOVUSW  0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
	br      gpre1
pmw:	movd	r1,scrch2(sb)
	MOVSUW	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gpex
 #
hgpmd:	movd	0(r0),r0		# in heaprelative r0 contains the
					# pointer to the wanted memory
gpmd:	cmpqb	geti,get_put(fp)	# (* set cc if operation is get *)
	bne	pmd
	MOVUSD	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
gpre1:	movd	scrch2(sb),r1
	br	gpex
pmd:	movd	r1,scrch2(sb)
	MOVSUD	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gpex
 #
gpbrl:	movd	n_gp(fp),r0
	cmpqb	$geti,get_put(fp)
	bne	pbrl
	movd	(brkar-8)(sb)[r0:d],r1	# get break point address
	br	gpex
pbrl:	movd	r1,(brkar-8)(sb)[r0:d]
	br	gpex
 #
gphe:	cmpqd	$geti,get_put(fp)
	bne	phe
	movd	heape(sb),r1
	br	gpex
phe:	movd	r1,heape(sb)
	br	gpex
 #
gphs:	cmpqd	$geti,get_put(fp)
	bne	phs
	movd	heaps(sb),r1
	br	gpex
phs:	movd	r1,heaps(sb)
	br	gpex
 #
gphp:	cmpqd	$geti,get_put(fp)
	bne	php
	movd	heapp(sb),r1
	br	gpex
php:	movd	r1,heapp(sb)
 #
 #gphp:	movd	heapp(sb),r0
 #      br	hgpmd
gpex:
	exit	[r0,r3]
	ret	8


 #
 # save user sb register if cfg in direct exception mode
 #

savesb:
	sprd	cfg,tos

	tbitb	$cfg_de,0(sp)		# direct exception?
	adjspb  $-4
	bfc	retsv			# no, return

	sprd	sb,tos			# store user sb
	lprd	sb,$dataad		# load monitor sb
	movd	tos,svsb(sb)		# store user sb in save area
retsv:
	ret 	0
#if (defined(mongx320) || defined(monlx32))

 #
 # UART initialization routine.  Sets up both UARTs for normal operation.
 # Baud rate is set according to value on bits 0-3 of the configuation
 # switch.

uart_init::
 	movb	$0x80, uart0+u_lcr	# enable divisor latch, ch. 0
 	movb	$0x80, uart1+u_lcr	# enable divisor latch, ch. 1
	movb    $1,uart1+u_afr          # set dual operation (uart1/2)
	movzbd	dip_switch, r2		# get baud rate selection
	#andb	$0x07, r2		# mask lower four bits for index
	dip_to_baud r2
 	movb	uarttb[r2:w], uart0+u_ldlr  # extract baud constants, store
 	movb	uarttb+1[r2:w], uart0+u_mdlr	#  to uarts.
        movb    $0x0f,uart1+u_mcr       # acivate DTR, RTS & OUT2
        movb    $0,uart1+u_afr          # clear dual operation
   	movb	$0x03, uart0+u_lcr	# set 8 bits, 1 stop, no parity
 	movb	$0x03, uart1+u_lcr	# set 8 bits, 1 stop, no parity
        movb    $0,uart1+u_ier          # disable all interupt
        movb    $0,uart0+u_ier          # disable all interupt
 	movb	$0x01, uart0+u_fifocr	# activate fifo on uart
	movb	$0x01, uart1+u_fifocr	# activate fifo on uart
 	movb	uart0+u_rx_data, r4		# flush uarts
 	movb	uart1+u_rx_data, r4
	jump	0(r7)			# return

 
 #
 # Size RAM routine.  This routine examines the RAM in 64K byte
 # blocks looking for the point of wrap-around.  RAM size is set
 # to this value minus 1.  
 #

size_ram:
	addr	ram_start, r4		# init pointer register
clear_lp:
	movb	$0x0, 0(r4)		# clear the location
	addd	$0x10000, r4		# increment
	cmpd	r4, $0x800000		# test for end (8Mb)
	blt	clear_lp
	addr	ram_start, r4		# init pointer again
	movb	$0x55, 0(r4)		# init first location
size_lp:
	addd	$0x10000, r4		# increment pointer
	cmpd	$0x800000, r4		# test for end (8Mb)
	beq	max_ram			# if 8Mb, we're done
	cmpb	$0x55, 0(r4)		# look for wrap around
	bne	test_ff 		# if not x'55, no wrap yet
max_ram:
	movb	$0, ram_start		# clear ram start
	addqd	$-1, r4			# if it is, wrap-around occured
	jump	0(r7)			# return to calling routine
test_ff:
	cmpb	$0xff, 0(r4)		# test for no ram (later boards?)
	beq	max_ram			# no ram, must be done
	br	size_lp			# continue

#endif

 #
 #
 #
 # build the interrupt dispatch table in the form of a link table
 #  Note that the 1st word in each 2 word entry must contain the
 # address of the module table. 
 #

.align 4
inttab:	
	.word	modad
	.word	nvirt-reset
	.word	modad     
	.word	nmirt-reset
	.word	modad     		# dummy for 'ABT' trap - this
	.word	abtrt-reset		#  should never happen w/32GX32
	.word	modad     
	.word	fpurt-reset
	.word	modad     
	.word	illrt-reset
	.word	modad     
	.word	svcrt-reset
	.word	modad     
	.word	mdvzrt-reset
	.word	modad     
	.word	flgrt-reset
bptint:	.word	modad     
	.word	bptrt-reset
trcint:	.word	modad     
	.word	trcrt-reset
	.word	modad     
	.word	undrt-reset
	.word	modad     
	.word	rbert-reset
	.word	modad     
	.word	berrt-reset
	.word	modad     
	.word	ovfrt-reset
	.word	modad     
	.word	mdbgrt-reset
	.word	modad     
	.word	reset-reset

 #
 # Interrupt dispatch entries for diagnostics ICU tests 
 #   - indirect exception
 #
#if	(defined(mon32gx) || defined(mon532))
	.word	modad     
	.word	dir0_iss-reset		# Counter interrupt service
	.word	modad     
	.word	derr_iss-reset		# error service for diagnostics
	.word	modad     
	.word	derr_iss-reset		# error routine for diagnostic purpeses
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "
	.word	modad     
	.word	derr_iss-reset		#               "

# endif
     #

modtab:	
	.double dataad
	.double	inttab
	.double	reset
	.double	0
 
 #
 #
 #
 #
 # build the interrupt dispatch table in pc relative (direct exception)
 # form.
 #

dinttab:	
	.double	nvirt
	.double	nmirt
	.double	abtrt
	.double	fpurt
	.double	illrt
	.double	svcrt
	.double	mdvzrt
	.double	flgrt
	.double	bptrt
	.double	trcrt
	.double	undrt
	.double	rbert
	.double	berrt
	.double	ovfrt
	.double	mdbgrt
	.double	reset

#ifdef mon532
	.double	dir0_iss		# for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses
	.double	derr_iss		# error routine for diagnostic purpeses



 #------------------------------------------------------------------------
 #
 # usrt_init is used only by diagnotic program.
 # inputs:
 #	r7 = return address (not use the stack or any ram
 # modified registers : r0,r1,r2
 #
	.set	dinit_dly,	0x20000		# delay usrt_init to setale
usrt_init:
	movd	$iobeg,r3
	movb	$5,r4
	movb	$0x1a,r2
usrt_lp:
	movb	r2,com(r3)		# reset usrt channel A
	movb	r2,com2(r3)		# reset usrt channel B
	addb	$0x10,r2		# next command
	acbb	$-1,r4,usrt_lp
	movb	$modr1,mr1a(r3)		# mr1a - mod reg control channel A
	movb	$modr2,mr2a(r3)		# mr2a - mod reg control channel A
	movb	$modr1,mr1b(r3)		# mr1b - mod reg control channel B
	movb	$modr2,mr2b(r3)		# mr2b - mod reg control channel B
  	movd	$switchp,r2		# get switch port
        movzbd	0(r2),r2		# get dip switch value
	andb	$0x0f,r2		# get only 4 lsb from dip switch
	movb	baud[r2:b],clk(r3)	# set baud rate for ch A (csra)
	movb	baud[r2:b],clk2(r3)	# set baud rate for ch A (csra)

	movb	$0xb0,acr(r3)		# select baud rate set, counter mode
	movb	opc(r3), r4		# stop counter
	movb	$0x32,iopcr(r3)		# clock at OP2
	movqb	$0,imr(r3)
	movb	$0xf,opc(r3)		# clear OP bits
	movb	$0x33,ops(r3)
	movb	$5,com(r3)		# enable rcv and trs
	movb	$5,com2(r3)
	movd	$dinit_dly, r4
usrt_dly:	acbd	$-1, r4, usrt_dly
	jump	0(r7)	

baud:	
	.byte 0xcc	# 19.2k
	.byte 0xbb	# 9600
	.byte 0x00	# 7200 usrt doesnt support
	.byte 0x99	# 4800
	.byte 0x00	# 3600 usrt doesnt support
	.byte 0x88	# 2400
	.byte 0x77	# 2000	
	.byte 0xaa	# 1800	
	.byte 0x66	# 1200	
	.byte 0x55	# 600	
	.byte 0x44	# 300	
	.byte 0x33	# 150
	.byte 0x22	# 134
	.byte 0x11 	# 110
	.byte 0x00 	# 75	
	.byte 0x00 	# 50

#include "diag532.s"
#endif
#ifdef  mon32gx
	.double	dir0_iss		# Counter interrupt service
	.double	derr_iss		# error service for diagnostics
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "
	.double	derr_iss		#               "

#include "mon32gx_p.s"
#endif mon32gx


		# Divisors Table for uart initialization
		
#if (defined (monlx32) )
uarttb:
	# baud rate table for GX32E 3 MSB on dip switch
	.word 120,120,30		#9600, 9600, 38.4K
	.word 480,120,240		#2400, 9600, 4800
	.word 60,920			#19.2K, 1200
	
	#.word 120,120,30		#9600, 9600, 38.4K
	#.word 60,120,240		#19.2K,9600, 4800
	#.word 480,920			#2400,1200

#endif

#if (defined (mongx320) )

uarttb:	
	.word	104			# 9600
	.word	104,26,52		# 9600, 38.4K, 19.2K
	.word	104,208,417,833		# 9600, 4800, 2400, 1200

prom_end:
	.double	0
#endif

