 # @(#)moncg.s	1.2	08/29/87
 # @(#)Copyright (C) 1985 by National Semiconductor Corp.
 #(***********************************************************************)
 #(*									*)
 #(*  	Copyright (c) 1985       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     moncg
 #
 #       version     2.00
 #
 #       date	01 - Jun - 1985
 #
 #	date	15 - Feb - 1988
 #		Updated for NS32CG16
 #		16 - Feb - 1989
 #		Version for NS32CG16 Evaluation / Development Board
 #		3/15/89
 #		Add support for DOS-type COM1 as transparent chan
 #
 #
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
 #
 #
	.file "moncg.s"
#include    "def.s"

 #
 #
 #   r e s e t    r o u t i n e
 #
 #
 
	.text
#ifndef	RAM	
reset:	br	reset1 + codesp	# jump to start of real rom

dramtbl:
	.double	M256K0W,M1M0W,M256K1W,M1M1W

reset1:
	movb	$(DS2 + SHADOW),@CTLL	#Turn off DS2 and Shadowing
	movzbd	@STATUS,r0		#Get the jumper setting
	andb	$3,r0			#mask off unwanted bits
	movd	dramtbl[r0:d],r0	#get the CG821 setup from dramtbl
	movqb	$0,0(r0)		#Program CG821 DRAM Controller
	movb	$(DS2 + SHADOW + DRAM_ML),@CTLL		
#else 
main::
reset:
#endif 					#Turn off DRAM Mode Latch
	setcfg	[i,f]
	            	 	# module  table address
                   	        # interrupt table address (link table address of
				# module montab) 
				# if any change is made that address should be
				# changed to the new value of link table address
				# of module montab
	bicpsrw	$psr_s		# {stop execution if psr_u on}
	addr	2000,r0		# wait for 2 milliseconds
	acbd	-1,r0,.		# to allow dram to stabilize
	addr	1000,r0		# do 1000 reads and writes
rlp1:	movw	0(r0),0(r0)	# do the operation
	acbd	-1,r0,rlp1	# to get the ram going
	addr	ui_rtn, r7	# set return address
	br	uart_init	# "call" uart_init
ui_rtn:
	movd	$modad,r2	# get destination of mod table
	movmd	rmodtab,0(r2),4 # copy mod table 
	lprw	mod,r2		# init mod register
	lprd	sb,0(r2)	# init sb register
	addr	intsp(sb),r2	# set r2 to point begining of interrupt table
	addr	rinttab,r1	# get source of inttab
	addr	(endinttab - rinttab)/2,r0 #number of words to move
	movsw			# copy the inttab
	addr	intsp(sb),r1	# point to the int table
#ifndef	RAM
	lprd    intbase,r1      # intbase:=address of inttab
#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(sb) := r1 {set high of mon sp}
	#addr    256(r1),svis(sb)    # svis(sb):=sp+256 init use is
	addr	svrsp(sp),svis(sb)    # svis(sb):=sp+256 init use is
	addr	nmirt,vstart	# initialize nmi vector
	addr    term1(sb),r7	# dtrm:=term1(sb)
	movd    r7,dtrm(sb)
	movqw   trma,ndtrm(sb)      # ndtrm:=trma (* set term a as default
   				# svcpf := false;
	movqd   stalon,opmod(sb)# operation mod := stand alone
   				# term a no echo no cr lf
   				# mon_usr := monitor  pndf := false
	movqd   0,svpc(sb)	  	# user_pc := 0
   	movqd	0,svpsr(sb)		# user_psr := 0
	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(sb):=0
	acbb    -1,r1,rst1
	addr    begina,strtadr(sb)	# save start address
	addr    endint,endadr(sb)	# save end interrupt routine address
	movqd	3,config(sb)		# set up config register [I,F]

	movzbd	@STATUS,r0		# read the jumpers
	andd	$0xc,r0			# Extract Jumpers 5-6 & 7-8 from W07
	cmpqd	4,r0			# if jumper 5-6 is disconnected and
					#    Jumper 7-8 is connected
	bne	no_dip
	movqb	1,use_dip(sb)
        movzbd  @switchp, 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:
	
	br	dip_con
no_dip:
	movqb	0,use_dip(sb)
dip_con:
	
	#
	#movd    $0x1b10000,svmsr(sb)	# init svmsr(sb) set tu ben ub ft ut
   	#movd	$0x90000,mnmsr(sb)		# monitor msr := tu,ao
rst14:  bsr     mainlp			# type reset message
 #
 #  e r r o r    e x i t
 #
	.set	enmi,-8		# error nmi
	.set	envi,-7		# error nvi
	.set	efpu,-6		# error fpu
	.set	edvz,-5		# error divide by zero
	.set	eund,-4		# error un-defined instruction
	.set	eflg,-3		# error flag trap
	.set	ebpt,-2		# error bpt
	.set	eill,-1		# error illegal instruction
	.set	etrc,0		# error trace trap
	.set	extr,1		# error external abort
	.set	eprt,2		# error protection
	.set	envl,3		# error invalied
	.set	eabt,4		# error abort
	.set	eusr,5		# user error
	.set	esvc,9		# svc error
	.set	evio,11		# vio protocol error
	.set	epnd,6		# pennding interrupt error
	.set	erts,13		# run time system error.
 #
begina:
error2: bsr     mnentr	 	# save user status load monitor status
error3:	bsr	brkrmva		# brkrmv {break remove routine}
	movxbd  errtyp(sb),r1    	# load error parameter
   	movd	svr0-4(sb),r0	# load number to be printed with error
error4: bsr     erent	  	# jump to error im command loop


	.globl	_back2mon
_back2mon:
	bsr	mnentr
	br	error
	
 #
 #
 #   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 this routine
	cmpqb   mont,mon_usr(sb)    	# if mon_user<> mont then
   					#	{ monitor 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
	addr    svr0+4(sb),scrch1(sb)
	lprd    sp,scrch1(sb)       	#   sp:= address of svr0(sb)
	save    [r0,r1,r2,r3,r4,r5,r6,r7]       # save r0-r7
					# end;
	lprw    psr,mnspr(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
 #   #	tbitb	$cnfmmu,config(sb)		# if cng.mmu on  then
 #   	bfc	mnentr3			#   begin
 #   	cmpqb	true,msrwf(sb)		#     if msr was not saved then
 #   	beq	mnentr2			#	begin
 #   	smr	msr,tmpmsr(sb)		#	  save msr;
 #   	lmr	msr,mnmsr(sb)		#	  msr := monitor msr;
 #mnentr2:				#       end;
 #   	movd	tmpmsr(sb),svmsr(sb)
 #  	orb	$0x90,svmsr+2(sb)		#     svmsr(sb).ben := 1 svmsr(sb).ft := 1
 #	cbitb   $msr_nt,svmsr(sb)       	#     msr.nt := 0
mnentr3:				#   end;
	addr    outb(r7),r6		# init dtrm.outb
   	#movqb	false,msrwf(sb)		# msrwf(sb) := false {for monitor time abt}
	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,mnspr(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(sb)
	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
mnext2:
 #	tbitb   $cnfmmu,config(sb)	  	# if config(sb).mmu then
 #	bfc     mnext1			#   begin
 #   	smr	msr,mnmsr(sb)		#     mnmsr(sb) := monitor msr;
 #	lmr     msr,svmsr(sb)		#     msr := svmsr(sb) {load msr}
 #  	movqb	false,msrwf(sb)		#     msrwf(sb) := false {save nsr flag}
mnext1: rett    0			#   end;
 #
 #
 #   multi interrups check & remove
 #
 #
multich:
   	cmpqb	mont,mon_usr(sb)	#if  not monitor_time  and psr_u = 0
   	beq	mul3			#then
   	tbitb	$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
	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   cr,'B',' '	# break point message
litret: .ascii	" RET"
litend:	.ascii	" END"
littrc: .ascii	" TRC"
 #
 #
brkrmva:movqb	false,r4	# testbp := flase
   	br 	rmv0
brkrmv: movqb	true,r4		# testbp := true
rmv0:	cmpqb	mont,mon_usr(sb)# if monitor time return
	beq	rmvex
	movqb   mont,mon_usr(sb)# mon_user:= monitor time
   	movqd   0,r3	    	# brkn:=0
   	movd    svpc(sb),r1	 	# r1:=use_pc
	movzbd  $nswbpt,r0	# for i:= nswbpt downto 1 do
rmv1:   movd    brkar-4(sb)[r0:d],r2 #begin
	cmpd	$0,r2		#    r2:=brkar(sb)[i];
	beq     rmv2	    	#    if brkar(sb)[i].be then
	andd    $0xffffff,r2    #   begin
   	cmpb    $bptc,ins-1(sb)[r0:b]#  if brkak[i] <> bpt then {not multi break}
	beq	rmv15
	movb  ins-1(sb)[r0:b],0(r2)#	 m(brkak[i].addr):=ins(sb)[i];
				#    (* reload instruction to memory *)
rmv15:  cmpd    r1,r2	   	#     if brkar(sb)[i].addr=user_pc then

	bne     rmv2	    	#     begin
	movd    r0,r3	   	#       brkn:=i
rmv2:   acbb    -1,r0,rmv1      # end for
   	cmpqb	true,r4		# if  not testbp then
   	beq	rmv3		#   return
rmvex: 	ret	0
rmv3:  	cmpqb   0,r3	    	# if bestbp and bprn>1 then (* software bp *)
	beq     rmv4	    	# begin
   	movd    mesg,0(r6)      #    outb(dtrm.outlm):=cr lf b
	movb    (hexan+1)[r3:b],3(r6) #  outb(dtrm.outlm):= ascii (brkn)
	addqd   4,r6	    	#    dtrm.outlm:=dtrm.outlm+7
	bsr     msgent	  	# end (goto message print)
rmv4:   cmpd	r1,endpc(sb)	# if use_pc = return from cxp then
	bne     rmvex	   	# begin
				# if 0(svpc(sb)) = bptc then
	# deleted tzvia 21/5/89
 #   	tbitb	$psr_u,svpsr(sb)	#  {do move or monus according to psr_u}
 #   	bfc	rmv4t	
 #   	movb	0(r1),scrch2(sb)
 #   	br	rmv4e
rmv4t: 	movb	0(r1),scrch2(sb)
rmv4e:	cmpb	$bptc,scrch2(sb)	#  {end of cxp or end of program}
   	bne	rmvex
rmv6:   movmd   oldpc(sb),svpc(sb),2    #    svpc(sb):=oldpc(sb) svus(sb):=oldus svis(sb):=oldis svmod(sb)
	movd    litret,2(r6)    #    outb(dtrm.outlm):= " ret"
   	movd	endpc1(sb),endpc(sb)	#    reload endpc(sb) of begin
	acbb    -1,cxpflg(sb),rmv5  #   cxpflg(sb):=cxpflg(sb)-1;
	movd    litend,2(r6)    #    if cxpflg(sb)=0 "b end" {end of program}
rmv5:   movw    mesg,0(r6)      #    outb(dtrm.outlm):=cr lf b
	addqd   6,r6	    	#    dtrm.outlm:=dtrm.outlm+7
	bsr     msgent	  	# end  (go to print message )
 #
 #
 #   b p t     routine
 #
 #
bptrt: bsr	mnentr		# mnentr {save user status & load monitor }
	bsr	brkrmv		# brkrmv {remove bpt's and find actual break}
bpter:  movqd   $ebpt,r1	# else
	br      error4	  	#    error(ebpt)
 #
 #
 #   t r a c e    t r a p    r o 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:  movqb	pndmod,mon_usr(sb)#	pending interrupts flag on.
 #	tbitb   $cnfmmu,config(sb)  # if mmu then
 #	bfc     trcm1		#
 #	cmpqb	true,msrwf(sb)	#   if not msrwf(sb) then {multi exception write}
 #   	beq	trcm0
 #   	smr     msr,tmpmsr(sb)      #	 tmpmsr(sb):=msr reg of mmu
 #   	movqb	true,msrwf(sb)	#	  msrwf(sb) := true {msr written flag}
 #trcm0: 	movd	tmpmsr(sb),svmsr(sb)
 #	lmr	msr,mnmsr(sb)	#    msr:=monitor msr
 #   	bsr	multich		# multi interrupt check
 #   	bsr	mmubr_ch	# mmu_break_point_check;
 #   	br	trct1
trcm1: 	bsr     multich	 	# multi-interrupt-check
trct1:  bsr 	mnentr		# emnentr {switch to monitor time}
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:  movqb   etrc,errtyp(sb)     # 0 : error_type:=etrc
	br      error3
trcgo:			  	# 1 : trace of go
	cbitb   $psr_t,svpsr(sb)    #       psr_t:=0
trcgo2: 
	# deleted by tzvia 21/5/89
 #	movb	$bptc,scrch2(sb)
 #   	tbitb	$psr_u,svpsr(sb)	#	move or monsu according to psr_u
 #   	bfc	trcgot
 #   	movb  scrch2(sb),0(actbrk(sb))#       m(pc):=bptc (* bpt ins(sb)trction
 #   	br	trcgoe
trcgot:	movb	$bptc,0(actbrk(sb))
trcgoe: addqb   (-stbrk),stepflg(sb)#	step_flag:=no monitor trace
	cmpqb   notrc,stepflg(sb)   #       if go & step trace goto trct1
	bne     trct2	   	#       else
trc2:   br	trc5
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,2(r6)    #	outb:=" trc"
trc33: 	bsr	brkrmv		#	     remove b.p. {exit to command loop}
   	br	rmv5		#	     exit to write message
trcstu: 			# 3 : stu/stu
	movqb   geti,tos	#       mnentr (* save user status
	movzbd  stuadd+3(sb),r2     #       getput (get,stuadd(sb).type,stuadd(sb).no)
	movd    stuadd(sb),tos
	movqb   0,3(sp)
	bsr     getput	  	#       (* find variable using get-put routine
	andd    stuadd+4(sb),r1     #       var:=var and mask
	checkd  r0,stuadd+8(sb),r1  #       f=var>=limit.lower and var<=limit.upper
	cmpqb   stu,stepflg(sb)
	bfs     trc6	    	#       if not f then
	beq     trc3	    	#	 if stepflg(sb)=stu goto trc3
trc5:   cmpqb	true,pndf(sb)	#	 else if was pennding interrupt
   	bne	trc55		#	   error pennding.
   	movqb	$epnd,errtyp(sb)	#	
   	br	error3
trc55: 	bsr	mnexit		#	  else return to user
trc6:   bne     trc3	    	#       else if stepflg(sb)<>stu goto trc3
	br	trc5		#	       else return to user
 #
 #
 #  n m i     r o u t i n e
 #
 #
 #
nmirt: 
 #	tbitb   $cnfmmu,config(sb)  # if no mmu then error nmi
 #	bfc     ernmi
 #   	cmpqb	mont,mon_usr(sb)# if nmi in montior time then error;
 #   	beq	ernmi
 #	cmpqb	true,msrwf(sb)	#   if not msrwf(sb) then {multi exeption write}
 #   	beq	nmim0
 #   	smr     msr,tmpmsr(sb)      # 	msrt:=msr reg of mmu
 #   	movqb	true,msrwf(sb)	#	  msrwf(sb) := true {msr written flag}
 #	lmr     msr,mnmsr(sb)       # 	msr:=disable all
 #nmim0:  cmpd	0(sp),scrch1(sb)    # {mmu break test }
 #   	bne	nmi2		# if return address = saved return address
 #   	tbitb	$psr_u,6(sp)	#  and psr_u = 0 then {was mmu beeak}
 #   	bfs	nmi2		#    remove last entry from stack
 #   	adjspb  $-12
 #   	xorb	$0x60,tmpmsr+1(sb)	# convert status to fetch
 #   	lmr	bpr0,svbpr0(sb)	# reload break points reg.
 #   	lmr	bpr1,svbpr1(sb)
 #	br	nmi20
 #nmi2:   bsr     mulpnd	  	# multich;
 #nmi20:	cmpqw   0,tmpmsr(sb)	# if msr.ststus:=0 goto error nmi
 #	beq     ernmi
 #	tbitb   $2,tmpmsr(sb)	# if b.p. go to nmi3
 #	bfs     nmi3
 #	tbitb   $13,tmpmsr(sb)      # if not ns trace
 #	bfc     ernmi		# then go error nmi
 #   	bsr	mmubr_ch	# mmu_break_point_check;
 #   	bsr	mnentr
 #   	br      trc3		# else  goto trca3
   				#   {remove bpt and goto command loop}
 #nmi3:   bsr     mnentr		# mnentr;
 #	extsd   tmpmsr(sb),r3,6,1   #  get b.p number
 #	movd    brmsg[r3:d],2(r6) #outb:=brmsg[bp] goto nmi2
 #	bsr	brkrmva		# remove software b.p.
 #   	br	rmv5		# print message and exit
 #brmsg:  .ascii	" 0  "
 #	.ascii  " 1  "
ernmi:  bsr     mulpnd	  	# multich; {check pennding mode}
   	movb    $enmi,errtyp(sb)    #
	cmpqb   mont,mon_usr(sb)# if uset time error(nmi)
	bne     error2
	cmpqb	3,ackflg(sb)	# In Ethernet mode ?
	beq	Et_nmi		# dont change ackflg, just print the message.
	movqb   1,ackflg(sb)	# else reset nmi
	bsr     mainlp	  	# {ackflg(sb):=1}

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




 #
 #
 #  a b o r t   r o u t i n e
 #
 #
abtrt: 
 #	tbitb   $cnfmmu,config(sb)  # if no mmu then error abt
 #	bfc     erabt
 #	cmpqb	true,msrwf(sb)	#   if not msrwf(sb) then {multi exeption write}
 #   	beq	abtm0
 #	smr     msr,tmpmsr(sb)      # tmpmsr(sb):=msr reg of mmu
 #   	movqb	true,msrwf(sb)	#	  msrwf(sb) := true {msr written flag}
 #	lmr	msr,mnmsr(sb)	# msr:=monitor msr
 #abtm0:  tbitb	$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
 #abr15: 	tbitb	$0,tmpmsr(sb)	# if not translation error
 #	bfc	abr4		# then goto abr4
 #	tbitb	$4,tmpmsr(sb)	# if non_valied 1 then error (inv)
 #	bfs	abr2		# else
 #	tbitb	$5,tmpmsr(sb)	#   in non_valied 2 then error (inv)
 #	bfs	abr2		
 #	movqb	eprt,errtyp(sb)	# else  error(prt)
 #	br	error3
 #abr2:	movqb	envl,errtyp(sb)	
 #	br	error3
 #abr4:	tbitb	$1,tmpmsr(sb)	# if msr(1)=1
 #   	bfc	erabt		# then
 #   	movqb	extr,errtyp(sb)	#   error(extr)
 #   	br	error3		# else
erabt:	movqb	eabt,errtyp(sb)	#   error(abt);
	br	error3
 ##
 #
 # e r r o r s    &   t r a p s
 #
 #
nvirt:	movqb	envi,errtyp(sb)
	br	error2
fpurt:	movqb	efpu,errtyp(sb)
	br	error2
illrt:	movqb	eill,errtyp(sb)
	br	error2
dvzrt:	movqb	edvz,errtyp(sb)
	br	error2
flgrt:	movqb	eflg,errtyp(sb)
	br	error2
undrt:	movqb	eund,errtyp(sb)
	br	error2
 #
 #
 # svc   r o u t i n e s
 #
 #
svclm:	.byte	13,3
svcrt:						#		gs
#ifdef  SAFE_SVC
        bicpsrw $0x800
#endif
	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:	movb	$esvc,errtyp(sb)
   	restore	[r0,r3]
	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
 #
endint:
 #
 #  s v c 3    r e a d n
 #
 #
svc3:	tbitb	$psr_u,tmppsr(sb)		# if psr_u then svcpf := true
   	bfc	svc33
   	movqb	true,svcpf(sb)
svc33:
	movqb	1,force_serial(sb)	# flag to force serial link
	movw	r2,tos
	movb	r3,tos			# rdlin(r2,r3,r1);
	movd	r1,tos
	bsr	rdlin
	movzwd	tos,r2			# r2:= # of read char
	movqb	0,force_serial(sb)	# flag to end force serial link
	cmpqb	5,r0			# of svc=terminal read (svc8)
	bne	svcex			# then
					# buffer[0]:=# of read char
   	tbitb	$psr_u,tmppsr(sb)
   	bfs	svct1
   	movw	r2,-2(r1)
   	br	svce1
svct1: 	movw	r2,scrch2(sb)
   	movw	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	error2			# else
svcex1:	movb	monusr1(sb),mon_usr(sb)	# flage user time
	rett	0
 #
 #
 #  s v c 4   p r i n t n
 #
 #
svc4:	tbitb	$psr_u,tmppsr(sb)		# if psr_u then svcpf := true
   	bfc	svc44
   	movqb	true,svcpf(sb)
svc44:
	movqb	1,force_serial(sb)	# flag to force serial link
	movd	r1,tos			# printa (r1,r1+r2,r3)
	movd	r2,tos
	addd	r1,tos
	movb	r3,tos
	bsr	printa
	movqb	0,force_serial(sb)	# flag to end force serial link
	br	svcex
 #
 #
 #  s v c 5   v i r t u a l    i / o
 #
 #
	.set	linlim,60		# max # of characters in a line
	.set	nlin,16			# max bytes to be send on one line
 #
 #
svc5:	save	[r1,r4,r5,r6,r7]
	movd	dtrm(sb),r7			# repeat
vo1:	movzbd	$nlin,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:	tbitb	$psr_u,tmppsr(sb)
   	bfs	svct2
   	movb	0(r1),scrch2(sb)
   	br	svce2
svct2:	movb	0(r1),scrch2(sb)
svce2: 	movzbd	scrch2(sb),tos
	movw	$0x200,tos		#     bntohx (buffer(i),2,0);
	bsr	bntohx
	addqd	1,r1			# {buffer pointer:=buffer pointer+1}
	addqd	-1,r2			#     n:=n-1;
	acbd	-1,r3,vo3		#   end; for
	movb	$cr,0(r6)		#   outb[i]:= cr;
	addqd	1,r6			#   outlm:=outlm+1;
	bsr	sprinta			#   sprinta {print outb}
	bsr	rdack			#   read_acknoledge
	cmpqd	0,r2
	blt	vo1			#   until n:=0;
	movd	16(sp),r1		# {bufferr pointer:=1}
vi1:	addr	(outb+2)(r7),r6		# outlm:=3;
	movw	$'V'+cr*0x100,outb(r7)	# outlm[1]:= "v" cr;
	bsr	sprinta			# sprinta {writeln("v cr"}
	bsr	rdack			# bsr read_acknoledge
	cmpqb	true,r6			# if endf<>1
	bne	vioex			# then
vi3:	adjspb	$5			#   repeat
	movd	r5,tos			#     hxtobn (x,inbu[i],2);
	addr	1(r5),tos
	bsr	hxtobn
	movd	tos,r5			#     {update scn}
	cmpqb	true,tos
	beq	vi5 #****Amir REA 1649
   	tbitb	$psr_u,tmppsr(sb)
   	bfs	svct3
   	movb	tos,0(r1)
   	br	svce3
svct3: 	movb	tos,scrch2(sb)
   	movb	scrch2(sb),0(r1)
svce3:	adjspb	$-3
	#*amir REA 1649  beq	vi1			#     if endf goto vi1
	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_acknoledge 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)
	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]
	movb	$evio,errtyp(sb)
rdack7:	restore [r0,r3]
	br	error2			#  end for;
 #
 #
 #   s v c 6    u s e r     e r r o r
 #
 #
svc6:	movb	$erts,errtyp(sb)		# run time error
   	br	rdack7
 #
 #
 #   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
   	tbitb	$psr_u,tmppsr(sb)   # if operation is read
   	bfc	svct4
   	movb	0(r1),scrch2(sb)
   	cmpqb	0,scrch2(sb)
	addqd	4,r1
   	movw	-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
   	cbitb	$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
 #
 #
 #
 #   test if there is  mmu break point on current instruction.
 #
 #
 #
mmubr_ch:
 #  	movd	4(sp),svpc(sb)
 #   	movw	10(sp),svpsr(sb)		# save pc and psr
 #   	movw	tmpmsr+2(sb),scrch1+2(sb)	# scrch1 := tmpmsr(sb) and 0xffff0000
 #   	movqw	0,scrch1(sb)
 #   	cbitb	$msr_ft,scrch1(sb)		# clear ft bit
 #   	orb	$0x10,scrch1+2(sb)		# set be bit
 #   	lmr	msr,scrch1(sb)		# load user msr disable flow trace.
 #   	smr	bpr0,svbpr0(sb)
 #   	smr	bpr1,svbpr1(sb)		# save beak points
 #   	tbitb	$bpr_ftch,svbpr0(sb)	# if bp0.fetch or bp1.fetch then
 #   	bfs	brch2			#  begin
 #   	tbitb	$bpr_ftch,svbpr1(sb)
 #   	bfc	brchex
 #brch2: 	movd	svbpr0(sb),scrch1(sb)		#     bp0.r := 1
 #   	movd	svbpr1(sb),scrch2(sb)
 #   	sbitb	$bpr_r,scrch1(sb)
 #   	sbitb	$bpr_r,scrch2(sb)
 #   	lmr	bpr0,scrch1(sb)
 #   	lmr	bpr1,scrch2(sb)		#     bp1.r := 1
 #   	movqb	false,msrwf(sb)
 #   	tbitb	$psr_u,svpsr(sb)		#     if psr_u then
 #   	bfc	brch4			#       read from user next instruction
 #   	addr	brcha,scrch1(sb)		#
 #	movb	0(svpc(sb)),scrch2(sb)		#     else
 #brcha: 	br	brch5			#       read from sup next instruction
 #brch4:	addr	brch5,scrch1(sb)
 #	movb	0(svpc(sb)),scrch2(sb)
 #brch5: 	lmr	bpr0,svbpr0(sb)		#     if was'nt nmi then
 #   	lmr	bpr1,svbpr1(sb)		#	reload mmu status
 #   	movqb	true,msrwf(sb)
 #brchex:	lmr	msr,mnmsr(sb)		#   end;
   	ret	0
 #
 #
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
 #     m o n i t o r    m a i n   l o o p
 #
 #
 #  table of commands name for search
 #
regntb: .byte   'P','C'    ,'U','S'
	.byte   'I','S'    ,'I','N'
	.byte   'S','B'    ,'F','P'
	.byte   'M','O'    ,'P','S'
 #	.byte   'M','S'    ,'E','I'
 #	.byte   'P','T'    ,'P','F'
 #	.byte   'S','C'	   ,'B','P'    
 #	.byte   'B','C'    ,'M','M'
	.byte   'S','P'    ,'F','S'
	.byte   'F',' '    ,'R',' '
	.byte   'C','F'    ,'H','S'
	.byte   'H','E'    ,'H','P'
	.byte   'M','B'    ,'M','W'
	.byte   'M','D'	   ,'L',' '
	.byte	'B','P'			# tzvia 21/5/89 print softw breakpoints
	.set	regtln, (.-regntb) / 2
	.set	prc,  12		# define print command
	.set	chcm, 13		# change command number
	.set	jsbc, 7		       	# jsb command number
	.set	stwc, 6			# stw command number
cmndtb: .byte   'M',' '    ,'F',' '
	.byte   'S','R'    ,'L',' '
	.byte   'D',' '    ,'S','U'
	.byte   'S','W'    ,'J','S'
	.byte   'C','X'    ,'G',' '
	.byte   'S','T'    ,'O','M'
	.byte   'P',' '    ,'C',' '
	.byte   'B',' '	   ,'R','I'
	.byte	'V','R'
	.set	cmntln,(.-cmndtb) / 2
crl:    .byte   cr,'L',space
rmsg:	.ascii	"R GNX MONITOR (MONCG16) VERSION 4 REV 2 "
rmsge:

et_msg:
        .ascii  " ETHERNET CONNECTION"
et_msge:
 
 #
 #
 #
mainlp:
	addr    (outb+1)(r7),r6		# dtrm.outlm:=3
	movb    $cr,-1(r6)	     	# outb(dtrm.outln-3):=cr
	movxbd  ackflg(sb),r3
procs: 	casew	protb[r3:w]		# case of ackflg(sb) :
protb: 	.word	pro0-procs
   	.word	pro1-procs
   	.word	pro2-procs
   	.word	pro3-procs
	#
 ###
pro0:
	movd	$(rmsge-rmsg),r0
	addr	rmsg,r1
	movd	r6,r2
	movsb				# move signon message to output buffer
	movd	r2,r6			# the end of the message

	cmpqb	$1,use_dip(sb)
	bne	xtrct_jmpr
	
#ifndef RAM
        movzbd  @switchp,r1             # Get the jumper setting
        andb    $0x7,r1                 # Test the ethernet
        cmpqd   1,r1
        blt     propt1                  # use serial line	
        movd    $(et_msge - et_msg), r0 # ethernet acknoledge
        addr    et_msg,r1
        movd    r6,r2
        movsb
        addd    $(et_msge - et_msg),r6
        movb    $cr,0(r6)		# outb[dtrm.outlm]:=cr
	addqd   1,r6			# dtrm.outlm:=dtrm.outlm+2;
	bsr     sprinta
                                        # else Use ethernet.
#endif
        movzbd  @switchp,r1
        andd    $1,r1                   # extract thin /thick bit
        xord    $1,r1                   # invert logic
	br	go_init			# and go to the init


				# Jumpers w07 5-6 and 7-8 are
				# used to flag ethernet vs serial
				# and thin vs thick ethernet.
				# Jumper 5-6 installed (closed) - ethernet
				# Jumper 7-8 installed (closed) - thin
xtrct_jmpr:
#ifndef RAM
 	movzbd	@STATUS,r1		# Get the jumper setting
 	andb	$4,r1			# Test the ethernet
	cmpqd	0,r1
 	bne	propt1			# use serial line
        movd    $(et_msge - et_msg), r0 # ethernet acknoledge
        addr    et_msg,r1
        movd    r6,r2
        movsb
        movd	r2,r6
        movb    $cr,0(r6)		# outb[dtrm.outlm]:=cr
	addqd   1,r6			# dtrm.outlm:=dtrm.outlm+2;
	bsr     sprinta
					# Use ethernet.
#endif
	movzbd	@STATUS,r1		# Check for thin/thick ethernet
	andb	$8,r1
go_init:
	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.
	#
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: movb    $cr,0(r6)		# outb[dtrm.outlm]:=cr
	addqd   1,r6			# dtrm.outlm:=dtrm.outlm+2;
	bsr     sprinta		 	# print (outb)
	br	mread:b
pro3:	
 	movb	$'*',-1(r6)
 	bsr	sprinta
mread:
	lprd    sp,mnsph(sb)		# set mon.sp to high
	movqb	false,pndf(sb)
	bsr     srdlin		  	# call standard read line  routine
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(sb) < 2
	ble     fscn4		   	# then
	cmpb    $'!',0(r5)	      	#   if chr<>"!"
	bne     mainlp		  	#   then goto mainlp
	movqb   2,ackflg(sb)		#   else   ackflg(sb):=-1 { not acknoledge}
	br      mainlp		  	# end
fscn4:  cmpb    $'!',0(r5)	      	#   if chr=="!"
	beq	mainlp
	addr    outb(r7),r6	     	# dtrm.outlm:=1
	addr    cmndtb,tos	      	# tbsrch (3,cmndtb,(cmndtbe-cmndtb)/4)
	movb    $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: casew   brtb[r2:w]	      	# main case of command-number
brtb:   .word   movelp-maincs   	# move
	.word   fillp-maincs    	# fill
	.word   srchlp-maincs   	# search
	.word   loadlp-maincs   	# load
	.word   dumplp-maincs   	# dump
	.word   stulp-maincs    	# step untile
	.word   stulp-maincs    	# step while
	.word   cxpl-maincs     	# jsb
	.word   cxpl-maincs     	# cxp
	.word   golp-maincs     	# go
	.word   stepl-maincs    	# step n
   	.word	opc-maincs		# operation mod
	.word   prntc-maincs    	# print
	.word   prntc-maincs    	# change
	.word   beginl-maincs   	# begin
	.word	rstintl-maincs		# reset intbase
	.word	version-maincs		# return version number and date
synterr:
error:  movb    $'?',0(r6)      	# writeln (* lf ? *)
	addqd   1,r6		    	#  outb(ndtrm.outlm):= ?
msgent:
	bsr     sprinta
	br      mainlp		  	# goto nainlp
 #
 #
	.set	evrf,12		 	# verify error constant
	#.set	epnd,6			# pending interrupt error
	.set	ecrc, 7		 	# crc error
	.set	esrc, 8		 	# search error
	.set	ecxp, 10		# error more then one cxp command
 #
 #     errors table
 #
ertab:  .ascii  " NMI NVI"
	.ascii  " FPU DVZ"
	.ascii  " UND FLG"
	.ascii  " BPT ILL"
	.ascii  " TRC EXT"
	.ascii  " PRT NVL"
	.ascii  " ABT USR"
	.ascii  " PND CRC"
	.ascii  " SRC SVC"
	.ascii  " CXP VIO"
	.ascii  " VRF RTS"
erent:
	movw    $cr+0x100*'E',0(r6)  		# insert cr lf e
	movxbd  r1,r1
	movd    (ertab+32)[r1:d],2(r6)	    	# insert error message
	addqd   6,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
   	bsr	bntohx				#   end;
erent2: br      msgent			  	# print message
 #
 #
 #	s h x t o b n  ( standard hxtobn  call )
 #
 #
shxtobn:
	movd    0(sp),tos
	addr    synterr,4(sp)   # exit address synterr
ehxtobn:
	bsr     comps	   	# compress leading space's
	adjspb  $5		# (* 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
	cmpqb   true,tos
	movd    tos,r1	  	# r1:=word
	bne     shxtbex	 	# if exrr then
	movd    4(sp),0(sp)     #    exit to error address
shxtbex:
	bsr     comps	   	# compress leading space's
	ret     4
 #
 #
 #   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	puti, 1	       		# put indicator
 #
 #
 #       registers parameters table
 #
regtb: .byte   0x60,0xff,0,svpc-serea	# pc description
usx:   .byte   0x60,0xff,0,svus-serea	# us
isx:   .byte   0x60,0xff,0,svis-serea	# is
       .byte   0x69,0xff,0,0		# intb
       .byte   0x60,0xff,-2,svmod-serea	# sb
       .byte   0x60,0xff,0,svfp-serea	# fp
       .byte   0x40,0xff,0,svmod-serea	# mod
       .byte   0x40,0xff,0,svpsr-serea	# psr
 #       .byte   0x88,0xff,0,svmsr-serea	# msr		# changed tzvia 21/5/89
 #       .byte   0x81,0xff,0,15	  	# eadd
 #       .byte   0x81,1,0,12		# ptb
 #       .byte   0x61,1,0,4		# pf
 #       .byte   0x81,0xff,0,8		# sc
 #brekx: .byte   0x81,1,0,0		# bpr
 #       .byte   0x61,0xff,0,11		# bcnt
 #       .byte   0x81,0xff,0,10		# real-msr	# end change
       .byte   0x62,0xff,0,0		# sp
       .byte   0x84,0xff,0,0		# fsr
       .byte   0x83,7,0,0		# fl
       .byte   0x80,7,0,svr0-serea	# r
       .byte   0x15,0xff,0,0		# cnfg
       .byte   0x60,0xff,0,heaps-serea 	# heap start
       .byte   0x60,0xff,0,heape-serea	# heap end
       .byte   0x60,0xff,-2,heapp-serea	# heap pointer
       .byte   0x26,0xf0,0,0		# mb
       .byte   0x46,0xf0,0,2		# mw
       .byte   0x86,0xf0,0,4		# md
       .byte   0xfa,7,0,0		# 64 bit L registers
sftx:  .byte   0x87,15,2,brkar-8-serea	# soft-bpt
 #
 #	.set	brekt,  (brekx-regtb) / 4	#chaged tzvua 21/5/89
 #	.set	sftbt,  (sftx-regtb) / 4	#changed tzvia 21/5/89
 #
prntc:  subb    $prc,r2	 	# push get-put parameter
	movb    r2,tos
	addr    regntb,tos      # tbsrch (regntb,regtln)
	movb    $regtln,tos
	bsr     tbsrch
	cmpqb   true,tos	# if tbsrch.exitf=false goto synterr
	bne     synterr
	movqd   0,r1
	cmpb    $0xff,(regtb+1)[r2:d]
	beq     pch1	  	# if regtb[n1,i]<>0xff then (* there is n*)
	bsr     shxtobn	 	#    hxtobn (n) (* on error go to synterr *)
pch0:   cmpb    $0xf0,(regtb+1)[r2:d] # mb,mw or md
	beq     pch1	  	#    if regtb[n1,i]=0xff then
	checkb  r0,(regtb+1)[r2:d],r1
		# changed tzvia 21/5/89
 #	bfc     pch1	  	#       if n>regtb.upper or n<regtb.lower
 #	cmpb    $brekt,r2       #       then if i<>brekt then
 #	bne     synterr	 	#	       goto synterr
 #	movb    $sftbt,r2       #	    else i=soft-break go to pch0;
 #	br      pch0
	bfs	synterr			# added tzvia 21/5/89
		# end change
pch1:   movd    r1,tos	  	# push n parameter
   	movd	r1,r0		# {save n}
	cmpqb   puti,4(sp)      # if l=chcm (*change command *) then
	bne     pch3
	cmpb    $'=',0(r5)      #    if m(dtrm.scn)<> "=" go to synterr
	bne     synterr	 	#    else
	addqd   1,r5	    	#       trm.scm:=dtrm.scn+1
 # $$$ 381 begin	added by tzvia 21/5/89
	cmpb	$0xfa,regtb[r2:d] # check if L registers
	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)	# a space?
	bne	pch1d		# no, continue
pch1c:	subd	$9,r1		# back up to end of the MS portion
	cmpd	r5,r1		# check if more than 8 digits (MS > 0)
	bgt	pch1a		# no, zero out MS portion
	adjspb  $5		# yes, call hxtobn to get MS portion
	movd    r5,tos	  	# vecp:=dtrm.scn
	movd    r1,tos    	# endp:=dtrm.inlm
	bsr     hxtobn	  	# hextobn (word,exrr,dtrm,scn,dtrm.inlm)
	movd    tos,r5	  	# update dtrm.scn
	cmpqb   true,tos
	movd    tos,fpubuf+4(sb)# store MS portion
	beq	synterr
	br	pch1b
pch1a:	movqd	0,fpubuf+4(sb)	# zero out MS portion
pch1b:	bsr	shxtobn		# get LS portion
	movd	r1,fpubuf(sb)   # store LS portion
	br	pch2a
pch2:
 # $$$ 381 end
	bsr     shxtobn	 	#       sxtobn(value) (*on error goto synterr*)
pch2a:	bsr     getput	  	#       getput (get-put,n,value);
	cmpb    0(r5),$'V'      #       if inbuf(dtrm.scn)="v"
	bne     mainlp	  	#       then
 # $$$ 381 begin changed tzvia 21/5/89
	cmpb	$0xfa,regtb[r2:d] # check if L registers
	bne	pch6
	movd	fpubuf(sb),sresp(sb) # save value for verifications
	movd	fpubuf+4(sb),sresp+4(sb)
	movzbd	$geti,tos
	movd	r0,tos
	bsr	getput		# get new value in the L register
	cmpd	fpubuf(sb),sresp(sb) # verify with saved value
	bne	pch7		# verification error
	cmpd	fpubuf+4(sb),sresp+4(sb)
	bne	pch7
	br	mainlp 
pch6:
 # $$$ 381 end
	movd    r1,r3	   	#	 oldvalue:=value;
	movqb   geti,tos
	movd	r0,tos		#	 getput(get,n,value);
	bsr     getput
	cmpd    r1,r3	   	#	 if oldvalue<>value
	beq     mainlp	  	#	 then
pch7:	movb	$evrf,r1	#	   error (vrf);
	br      erent	   	#       end;
				#    end;
				# else
pch3:   bsr     getput	  	#    getput (get_put,n,value)
	movb    $'=',0(r6)	#    outb(dtrm.outlm):="=";
	addqd   1,r6	    	#    dtrm.oulm:=dtrm.outlm+1;
	movd    r1,tos
 # $$$ 381 begin added tzvia 21/5/89
	cmpb	$0xfa,regtb[r2:d]
	bne	pch4
	movd	fpubuf+4(sb),tos# MS portion
	movb	$8,tos		# 8 bytes
	movqb	2,tos		# leading zero suppressed
	bsr     bntohx
	movd	fpubuf(sb),tos	# LS portion
	movb	$8,tos		# 8 bytes
	movqb	0,tos		# no zero suppression
	br	pch4a
pch4:
 # $$$ 381 end
	extsb   regtb[r2:d],tos,4,4     #  (* get rebtb.length *)
	movqb   2,tos	   	#    bntohx (r1,regtb.length,2)
pch4a:	bsr     bntohx
	bsr     sprinta	 	#    writeln (outb)
	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:   cbitb   $psr_t,svpsr(sb)	# svpsr(sb)_t:=0 (* disable trace *)
	movqb   $notrc,stepflg(sb)  # stepflg(sb):=stbrk#
stdgo:  movzbd  $nswbpt,r0	# for i:=nbreak-2 dowen to 1 do
gol1:   cmpd   $0,brkar-4(sb)[r0:d] #if brkar.be[i] then do (* b.p. i enable
	beq     gol5	   	#       begin
	movd    brkar-4(sb)[r0:d],r1
	andd    $0xffffff,r1    #	 r1:=brkar[i].addr
	movb  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
	sbitb   $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
 #	movb    $bptc,0(r1)     #	   m(brkar[i].addr):=bpt;
gol4:	movb	$bptc,scrch2(sb)
   	movb	scrch2(sb),0(r1)
 #   	cmpb	$bptc,0(r1) 	#	   if not written  then
   	movb	0(r1),scrch2(sb)
   	cmpb	$bptc,scrch2(sb)
   	beq	gol5
   	movd	r1,r0		#	    error vrf
   	movb	$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
	addr    stp2,tos
	bsr     ehxtobn	 	# shxtobn (n) (* on error go to stp2 *)
	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
	sbitb   $psr_t,svpsr(sb)    # svpsr(sb)_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: 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(sb)=2 {second cxp}
	bne     cxpl1	   	# then error cxp
	movzbd  $ecxp,r1
	br      erent
cxpl1:  movqb   2,cxpflg(sb)	# else cxpflg(sb):=2;
   	movmd   svpc(sb),oldpc(sb),2    # save pc,us,is,mod
   	movd	endpc(sb),endpc1(sb)	# save endpc(sb) of last begin
	movd	$js_bpt, endpc(sb)
cxpl2:  addr    svus(sb),r3	 	# r3:=addr of us
	tbitb   $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	8(r2),scrch2(sb)
   	addd	scrch2(sb),r1
	addqd   -4,r0
   	movd	svmod(sb),0(r0)	#  push return mod the same as cxp mod
   	movd	0(r0),scrch2(sb)	# {verify write}
   	cmpd	svmod(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)	#
   	movd	scrch2(sb),0(r0)
   	movd	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(sb)=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,regtb,regnln)
	movb    $regtln,tos
	bsr     tbsrch
	cmpqb   true,tos	# if  not exitf then  goto synterr
	bne     synterr	 	# else
	movqd   0,r1	    	#   n parameter :=0
	cmpb    $0xff,(regtb+1)[r2:d]
	beq	stu3		#   if regtb[n1,i]=0xff then
	bsr	shxtobn		#   hxtobn (n) (* on error goto synterr *)
	cmpb	$0xf0,(regtb+1)[r2:d]# if regtb[n1,i]=0xff then
	beq	stu3
	checkb	r0,(regtb+1)[r2:d],r1#   if n>regtb.upper or n<regtb.lower
	bfs	synterr		#       then goto synterr#
stu3:	movd	r1,stuadd(sb)	#   stuadd(sb):=n
	movb	r2,stuadd+3(sb)	#   stuadd(sb).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(sb)[i]:=value
	acbb	-1,r0,stu6	# end ;
	movb	r3,stepflg(sb)	# stepflg(sb):=stu or stw
	sbitb	$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	$5
	movd	r5,tos		# hxtobn (x,exitf,dtrm.scn,dtrm.scn+1);
	addr	1(r5),tos
	bsr	hxtobn
	movd	tos,r5		# update dtrm.scn
	cmpqb	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
	movb	scrch2(sb),0(r1)	#   m(addr)=x;
				#    if m(addr)<>x then goto vrferr
   	movb	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:	movqd	ecrc,r1		# else error (crc)
	br	erent
vrferr:	movd	r1,r0		# r0 := address of verification.
vrferr1: movb	$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
	movqb	7,r3
flod1:	movqw	true,tos	# for i := 1 to 7 do
	movb	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
	movb	ndtrm(sb),tos	# rdlin (n,ndtrm,term1(sb));
	addr	term1(sb),tos	#  {max buffer read is 256}
	bsr	rdlin
	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:	movb	term1(sb)[r3:b],0(r0)
	movb	0(r0),scrch2(sb)	#   adr^ := term1(sb)[i]
	cmpb	term1(sb)[r3:b],scrch2(sb)#   if  adr^ <> term1(sb)[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
	movqd	epnd,r1		# else go to main loop
	br	erent
 #
 #
 #
 #	d u m p    c o m m a n d
 #
litr1:	.ascii	"TR1 "
litr2:	.ascii	"TR2 "
 #
 #
	.set	nlin1,16		# number of byte in a line
 #
dumplp:
	movb	ndtrm(sb),r4	# term:=ndtrm
	cmpd	litr1,0(r5)	# if m(ndtrm.scn) = "tr1 "
	bne	du2		# then
	movqb	0,r4		#   term:=0
	br	du4		#   dtrm.scn:=dtrm.scn+4;
du2:	cmpd	litr2,0(r5)	# else
	bne	du5		#    if m(dtrm.scn) = "tr2 "
	movqb	1,r4		#    then  term:=1;
du4:	addqd	4,r5		#	   dtrm.scn:=dtrm.scn+4;
du5:				# end; if
	bsr	shxtobn		# hxtobn(addr1);
	movd	r1,r2		# {r2:=addr1}
	cmpb	0(r5),$'*'	# if * then fust dump
	beq	fdump
	bsr	shxtobn		# shxtobn(addr2);
dulin:				# repeat
	movqd	0,r3		#   crc:=0;
	addr	term1(sb),r6	#   outb:=term1(sb).outb
	cmpqb	0,r4		#   if term <> term1(sb)
	beq	dul3		#   then outb:=term2(sb).outb
	addr	term2(sb),r6
dul3:	movd	r6,tos		# {push start address 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,6,2);
	movw	$0x602,tos
	bsr	bntohx
	movb	$space,0(r6)	#   outb(outlm):=space;
	addqd	1,r6		#   outlm:=outlm+1
	movzbd	$nlin1,r0	#   l := nlin {# of bytes in a line}
	cmpd	r1,r0		#   if n<nlin
	bge	duloop		#   then l := n;
	movd	r1,r0
				#   for i=1 to l do
duloop: movb	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);
	bsr	bntohx
	addqd	-1,r1		#      n := n-1;
   	acbd	-1,r0,duloop	#   end#   {for}
	movzbd	r3,tos		#   bntohx(crc,2,0);
	movw	$0x200,tos
	bsr	bntohx
	movd	r6,tos		#   {parameters for printa}
	movb	r4,tos
	cmpqd	0,r1		#   if n=0
	beq	duext		#   then goto duext;
	bsr	printa		#   printa (outb(1),outb(outlm),term,ophnd)
	br	dulin		# until addr1>addr2
duext:	movb	$cr,0(r6)	# outb(outlm):= cr ;
	addqd	1,1(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:	movb	0(r2),term1+1(sb)[r3:b]
	addqd	1,r2		#    term1(sb)[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);
	movb	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);
	movqb	3,tos
	bsr	tbsrch
	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:	movb	0(r5),scrch2(sb)	#     "b"  x:=m(source-addr)
	addqd	1,r5		# 	   source-addr:=source-addr+1;
fillb:	movb	scrch2(sb),0(r0)	#	   m(destinatin-addr):=x;
srchb:
	movb	0(r0),tos
   	cmpb	scrch2(sb),tos
spcf:	tbitb	$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);
	bsr	bntohx
	br	msgent		#		sprinta; return to mainlp;
				#	      end;
				#	   end;
spcrp:	addd	tos,r0		#	   destination-addr:=destination+step
	cmpd	r0,r3		# end for
	ble	spcl
	cmpqb	srchc,r4	# if not srch command then return to mainlp
	beq	sperr		# else
	br	mainlp
sperr:	movzbd	$esrc,r1	#  error (src);
	br	erent
fillw:	addqd	1,0(sp)		#	   step:=step+1;
	movw	scrch2(sb),0(r0)	#    "w"    m(destination-addr):=x
srchw:
	movw	0(r0),tos
   	cmpw	scrch2(sb),tos
	br	spcf
filld:	addqd	3,tos		#	     step:=step+3;
	movd	scrch2(sb),0(r0)	#     "d"    m(destination-addr):=x;
srchd:
   	movd	0(r0),tos
   	cmpd	scrch2(sb),tos
	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
opc:
        cmpqb   3,ackflg(sb)    #Config command are not valid on ethernet
        beq     synterr         
        
	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	opc
op1:	movqd	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
	acbd	-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
	movqb	2,ackflg(sb)		# set mode to serial
	br	opc
opblsq:
	movb	r1,cntrlb-3(sb)[r2:b]
	br	opc



 #
 # r e s e t    i n t b a s e
 #
 #
rstintl:
#ifndef	RAM 
	lprd	intbase,rstint(sb)	# load initbase with reset value
#endif
	br	mainlp

 
verhd:
	.ascii	" GNX MONCG16 4.2 creation time:"

	.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,60	# max number of characters in input line
 #
srdlin: enter	[r0,r1],0
	cmpqb	stalon,opmod(sb)# if opmod=transparent
	beq	srdlin2		# then
	bsr	transr		#   transr;
	addr	inbuf(r7),r5	#   dtrm.scn:=1;
	br	lwrlp		# else
srdlin2:
	movxbw	$-linlim,tos
   	movb	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
 #
 # 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:	addqd	1,r0		#   end
	cmpd	r0,inlm(r7)
	blt	lwr0
	exit	[r0,r1]
	ret	0
lwrcb:	.byte	'z','a'		# limits of upper and lower letters
 #
 #
 #    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,13	# rdn : integer*2 max # of bytes
	.set	rdtrm,12	# rdtrm : integer*1 terminal ;
	.set	rdvec,8	# var rdvec : char[1..rdn]
 #
rdlin:
	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
	enter	[r0,r1,r2],0		# for clean interface to C
	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	5
rd_serial:
	enter	[r1,r2,r3],0
	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
					# repeat
rdlin1:	movqw	true,tos		# {rdchr (chr,false,rdtrm)}
	movb	rdtrm(fp),tos
	bsr	rdchr
	adjspb	$-1			# {remove endf}
	movb	tos,r3			# chr:=rdchr (false,rdtrm);
   	movb	rdtrm(fp),tos
   	bsr	doecho			# doecho(chr,rdtrm)
	cmpb	$delete,r3		# if chr:=delete
	bne	rdlin2			#  then
	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; {mov}
   	movb	scrch2(sb),0(rdvec(fp))
   	br	rdlin4			#    else
rdlin3:	movb	r3,0(rdvec(fp))		#       vec(n) := chr   {mov}
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
rdlinex:
	movw	r2,rdn(fp)			# rdlin:=n
	exit	[r1,r2,r3]
	ret	5
 #
 #    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
 #
doecho: 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:	tbitb	$echob,r1	# if echo then
   	bfc	ecex		# begin
ec3:   	movqb	true,tos
   	movb	r3,tos
   	movb	ec_trm(fp),tos	#   prchr (ture,ec_chr,ec_trm)
 #coff  	sprd	mod,tos
   	bsr	prchr
   	cmpqb	true,tos	#   {adjast stack}
   	cmpb	r3,$cr		#   if ec_chr=cr then
   	bne	ec4
   	tbitb	$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	1	
 #
 #
 #    r d c h r      ( dummy read char procedure )
 #
 #
 # procedure rdchr (wait,trm)
 #
	.set	rd_chr,10	# procedure value
	.set	rd_wait,9	# wait/nowait flag
	.set	rd_trm,8	# terminal number
 #
rdchr:	enter	[r1,r2],0
	movd	$UART,r1	# r1: address of trminal a
   	cmpqb	trma,rd_trm(fp)	# if trminal_num<> 0 then
   	beq	rdchrlp
	movd	$UART1,r1 	# r1: address of trminal b
rdchrlp1:			# do while in_rdy=0 and rd_wait(fp)=true
	tbitb	$RDA,LSR/2(r1)	#   input in_rdy
	bfs	rdchr3a	
	cmpqb	true,rd_wait(fp)
	beq	rdchrlp1	# end;
	br	rdchrex
rdchr3a:movb	RBR/2(r1),rd_chr(fp) # rdchr:=usart data
	br	rdchr4

rdchrlp:			# do while in_rdy=0 and rd_wait(fp)=true
	tbitb	$RDA,LSR(r1)	#   input in_rdy
	bfs	rdchr3	
	cmpqb	true,rd_wait(fp)
	beq	rdchrlp		# end;
	br	rdchrex
rdchr3:	movb	RBR(r1),rd_chr(fp) # rdchr:=usart data
 #	andb	$0x7f,rd_chr(fp)
rdchr4:	movqb	true,rd_wait(fp)	# rd_wait(fp):=true
rdchrex:
	exit	[r1,r2]
	ret	1
 #
 #
 #	 t r a n s p a r e n t     m o d e    r e a d
 #
 #
	.set	trscmd,-2		# trscmd : array of boolean
	.set	svtrm2,-6		# svtrm2 : integer {term2 address}
	.set	svtrm1,-10	 	# svtrm1 : integer {term1 address}
	.set	trsc,-12 		# trsc	: array of integer*1 {counters}
 #
transr:	enter	[r1,r2,r6],12
   	movqw	0,trscmd(fp)		# trscmd[1] := 0 trscmd[2] := 0
	movqw	0,trsc(fp)			# trsc[1]:=0; trsc[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
	movb	r1,tos			#   rdchr (chr,false,endf,term);
	bsr	rdchr
	cmpqb	true,tos		#   {r2:=chr}
	movb	tos,r3			#   if endf then
	bne	trs1			#   begin
	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
	br	trs1			#	    else
trs5:	xorb	$1,r1
	movqb	true,tos
	movb	r3,tos			#	      prchr(true,chr,next term)
	movb	r1,tos			#	end;
	bsr	prchr			#     end
	cmpqb	true,tos		#   {pop pr_ready}
	br	trs2			#   else
trs7:	movb	r1,tos			#     doecho (term,chr)
   	bsr	doecho
	movd	svtrm1(fp)[r1:d],r7		#     {r7:=pointer to term-buffer}
	cmpb	r3,$delete		#     if chr=delete then
	bne	trs9			#     begin
	cmpqb	0,trsc(fp)[r1:b]		#       if cont[term]>0
	bge	trs1			#       then
	addqd	-1,trsc(fp)[r1:b]		#	  trsc[term]:=trsc[term]-1;
	br	trs1			#     end
trs9:	addr	inbuf(r7),r6		#     else
	movzbd	trsc(fp)[r1:b],tos		#     begin
	addd	tos,r6			#	inbuf[term,trsc[term]]:=chr;
	movb	r3,0(r6)
	movd	r6,inlm(r7)		#	inlm[term]:=trsc[term];
	addqb	1,trsc(fp)[r1:b]	#	trsc[term]:=trsc[term]+1;
	cmpb	$endlin,r3		#     end;
	beq	trs10			# until (chr=endlin)
	cmpb	$linlim,trsc(fp)[r1:b]	#      or (trsc[term]>linlim);
	bgt	trs1
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:	cmpb	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 nedded
 #
 # local constants
 #
	.set	printe,0		# end of line indicator
 #
	.set	arrp,13  		# var: array of chr
	.set	endp,9   		#  pointer
	.set	prtrm,8 		#  integer [0..1]
 #
printa:	
	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	9
pr_serial:
	enter	[r1,r2,r3,r4,r5,r6],0
	movd	arrp(fp),r1		# r1:=pointer to print array
   	movb	ophnd(sb),r2	# r2:= opmod [prtrm(fp)]
   	cmpqb	trma,prtrm(fp)
   	beq	prntlp
   	lshb	$-4,r2
prntlp:
   	cmpqb	true,svcpf(sb)	# if svcf then
   	bne	prnx1
   	movb	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(fp)) read no wait
	movb	prtrm(fp),tos
	bsr	rdchr
	movb	tos,r5		#    {pop firtst argument }
	tbitb	$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(sb) 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(sb) go to read char
				#	   else end of /s/q go to print
prnx2:	movb	$false,tos	# go to exit
	movb	r4,tos		#   prchr(true,m(arrp(fp)),prtrm(fp))
	movb	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(fp)] and m[arrp(fp)]=cr]
   	bne	prnt8		# then
   	tbitb	$handb,r2	# begin
   	bfc	prnt5
   	movqb	0,r3
precho:	movqw	true,tos	#    rdchr (chr,false,rdtrm)
	movb	prtrm(fp),tos
	bsr	rdchr
   	cmpqb	0,tos		#   {remove endf from stack}
   	cmpb	$cr,0(sp)
   	bne	prnt4
	cmpqb	0,tos		#unstack
   	tbitb	$handlf,r2	#    if hnd[prtrm(fp)] wait to cr
   	bfc	prnt5
   	movqb	1,r3
   	br 	precho
prnt4:	cmpb	$lf,tos
	bne	precho		# end
   	cmpqb	1,r3
   	bne	precho
prnt5:	tbitb	$echolf,r2	# if echolf[prtrm(fp)] then
   	bfc	prnt8		# begin
   	movb	$lf,r4		#   echo with lf
   	br	prnt2		# end;
prnt8: 	addqd	1,r1
	cmpd	r1,endp(fp)		#  repeat untile arrp(fp)>endp(fp)
	bge	prtaex
	br	prntlp
prtaex:
	exit	[r1,r2,r3,r4,r5,r6]
	ret	9
 #	.endproc
 #
 #
 #	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
 #
 #
sprinta:
	addr	outb(r7),tos
	movd	r6,tos		# printa (dtrm.outb,dtrm.outlm,dtrm)
	movb	ndtrm(sb),tos
	bsr	printa
	ret	0
 #
 #
 #
 #	p r c h r    ( print character )
 #
 #	function - send one character to terminal
 #
 #	calling sequence prchr(endf,wait,chr,trm)
 #
 #	 endf/wait	
 #	 	booleano  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,10		# wait : boolean
	.set	chr_pr,9  		# ascii chr
	.set	trm_chr,8  		# terminal number
 #
prchr:	enter	[r1,r2],0
	movd	$UART,r1	# r1: address of trminal a
   	cmpqb	trma,trm_chr(fp)		# if trminal_num<> 0 then
   	beq	prchrlp
	movd	$UART1,r1 	# r1: address of trminal b
prchrlp1: tbitb	$THRE,LSR/2(r1)		# if tx-rdy = 0
	bfs	prchr3a			# then
	cmpqb	false,wait_pr(fp)		#   if wait then repet
	bne	prchrlp1
	br	prchrex			#   else wait:=false
prchr3a:movb	chr_pr(fp),THR/2(r1)
	br	prchr4

prchrlp: tbitb	$THRE,LSR(r1)		# if tx-rdy = 0
	bfs	prchr3			# then
	cmpqb	false,wait_pr(fp)		#   if wait then repet
	bne	prchrlp
	br	prchrex			#   else wait:=false
prchr3:	movb	chr_pr(fp),THR(r1)
prchr4:	movqb	true,wait_pr(fp)		# else write(data-port,chr)
prchrex:
	exit	[r1,r2]
	ret	2
 #
 #
 #	h x t o b n  (hexa-decimal to binary)
 #
	.set	word_hb,17		# word_hb(fp) : dinteger
	.set	exrr_hb,16  	# exrr : integer
	.set	vecp_hb,12  	# vecp : var :pointer
	.set	endp_hb,8  		# endp : pointer
 #
hxtobn:	enter	[r0,r1,r4],0
	movqd	0,r4			# word:=0
	movqb	true,exrr_hb(fp)		# exrr:= true
htblp:	addr	hexan+15,r1		# (* r1:= address hexan+16 *)
	movzbd	$16,r0			# i:=17 (* i in r0 *)
 #
htb1:	cmpb	0(vecp_hb(fp)),0(r1)	# if m(vecp)<>hexan[i]
	addqd	-1,r0			# then
	beq	htbf1
	cmpqd	0,r0			#    if i=0 then exit
	beq	htbex
	addqd	-1,r1			#    else i:=i-1
	br	htb1
htbf1:	ashd	$4,r4
	addd	r0,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	[r0,r1,r4]
	ret	4
hexan:	.ascii	"0123456789ABCDEF"
 #
 #
 #	b n t o h x   (binary to hex-decimal conversion)
 #
 #
	.set	word_bh,10 		# word : dinteger
	.set	n_bh,9   	 	# n : integer
	.set	type_bh,8		# 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	6
 #
 #
 #	t b s r c h  (table search procedure )
 #
 #
	.set	tabadr,9 		# tabaddr : pointer
	.set	length,8 		# length : integer
	.set	exitf,12 		# 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	4
 #
 #
 #	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,msr,eadd,ptb,pf,
 #		   sc,bpr,bcnt,real-msr,sp,fl,fsr,r,f,fsr,cfg,soft-bpr
 #		   heap-start,heap-end,heap-pointer
 #
 #		   memory is : byte word double
 #
 #		   r2 contains(sb) register # (or memory)
 #
 #	calling sequence getput (get_put,type,n,value)
 #	      getput -  0 get
 #			1 put
 #	      type   -	register type (in r2)
 #	      n      -	register number
 #	      value  -  value get (or put) in r1
 #
	#.set	geti,0			# get indicator
	##.set	puti,1			# put indicator
	.set	mmsrc,15		# mmsr number in regtb
 #
	.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
	cmpqb	geti,get_put(fp)		# (* set cc if operation is get *)
	extsb	regtb[r2:d],r3,0,4	# get operation type
lgp:	casew	case_gp[r3:w]		# case of operatin number
case_gp: .word	gmpul-lgp		# mpu operation
	 .word	gmmul-lgp		# mmu   "
	 .word	gspl-lgp		# sp    "
	 .word	gfpul-lgp		# fpu   "
	 .word	gfsrl-lgp		# fsr   "
	 .word	pcfgl-lgp		# cfg   "
	 .word	gml-lgp			# memory "
	 .word	brl-lgp			# soft-break
   	 .word  gmsrl-lgp		# msr
   	 .word  intbl-lgp		# intbase
	 .word  gnfpul-lgp		# fpu reg l1,l3,l5,l7
gmsrl:
 #	smr	msr,scrch1(sb)		# trap if no mmu
gmpul:	negd	r0,r0
brl:	muld	$4,r0
	movzbd	(regtb+3)[r2:d],r3
	addd	r3,r0			#    r0:=regtb.offset+4*r0
gmpul2:	addr	serea(sb)[r0:b],r0
   	cmpqb	-2,(regtb+2)[r2:d]
   	bne	gmpul3		# if regtb.l2=-2 then  {heap and sb indirect
   	movd	0(r0),r0	#    r0  := m[r0]	read}
   	movb	$18,r2		#  *** regtb definition ***
   	br	gml
gmpul3:	cmpqb	geti,get_put(fp)
	bne	pmpul		# if get command then
	movd	0(r0),r1	#    r1:=serea(sb)[regtb.offset]
	br	gprex
pmpul:	movd	r1,0(r0)	# else  serea(sb)[regtb.offset]:=r1#
	br	gprex
 #
 # get put sp
 #
gspl:	movb	usx+3,r0
	tbitb	$psr_s,svpsr(sb)	# if psr_s then
	bfs	gmpul2		#    r0:=us-offset
	movb	isx+3,r0	# else
	br	gmpul2		#    r0:=is-off_set
 #
 # get put intbase
 #
intbl:	bne	intb4		# if get then
   	sprd	intbase,r1	#  r1 := intbase
   	br	gprex		# else
intb4: 	lprd	intbase,r1	#    intbase := r1;
   	br	gprex
 #
 # get put fpu reg
 #
movfi1: movf	f0,4(sp)
movfi2: movf	4(sp),f0
 #
gfpul:	movd	r1,tos		#move data to stack
   	bne	pfpul		# if get then
   	movd	movfi1,jmpram(sb)	# copt movff ins(sb) to ram
	movqd	3,r3
   	insb	r3,r0,jmpram+2(sb),5#   change gen 1
   	br	gfpu4		# else
pfpul: 	movd	movfi2,jmpram(sb)	# copt movff ins(sb) to ram
	movqd	6,r3
   	insb	r3,r0,jmpram+1(sb),5	#   change gen 2
gfpu4:	movw	ret0,jmpram+4(sb)	# copy ret 0 ins(sb)
   	jsr	jmpram(sb)		# execute movff ins(sb)
gfpu6:	movd	tos,r1		# copy from stack to r1
   	br	gprex
 #
 #
 # $$$ 381 begin added tzvia 21/5/89
 #
 #  get put 64 bit fpu registers L0-L7
 #
	.align  4
movnl1:	movl	l0,fpubuf(sb)
movnl2:	movl	fpubuf(sb),l0
 #
gnfpul:	bne	pnfpul			# if get then
	movd	movnl1,jmpram(sb)
	movb	movnl1+4,jmpram+4(sb)
	movqd	3,r3
   	insb	r3,r0,jmpram+2(sb),5	#   change gen 1
	movw	ret0,jmpram+5(sb)
	jsr	jmpram(sb)
gnfpu2:	br 	gprex
 #
pnfpul:	movd	movnl2,jmpram(sb)	#   put the register back
	movb	movnl2+4,jmpram+4(sb)
	movqd	6,r3
	insb	r3,r0,jmpram+1(sb),5	#   change gen 2
	movw	ret0,jmpram+5(sb)
	jsr	jmpram(sb)
	br	gprex
 #
 # $$$ 381 end
 #
 #
 #
 # get put fsr
 #
 #
gfsrl:	bne	pfsrl		# if get then
	sfsr	tos		#   move fsr to stack
   	br	gfpu6		# else
pfsrl:	movd	r1,tos		# move r1 to fsr via stack
   	lfsr	tos
   	br	gprex
 #
 # get put mmu reg
 #
smrl:
 #	smr	bpr0,temp(fp)	# smr instruction
lmrl:
 #	lmr	bpr0,temp(fp)	# lmr instruction
ret0:	ret	0		# ret 0 instruction
 #
gmmul:
 #	movd	r1,temp(fp)
 #   	movd	smrl,jmpram(sb)	# if getput:=get then
 #	beq	mmul2		#    copy smr to ram
 #	movd	lmrl,jmpram(sb)	# else copy lmr to ram
 #   	cmpb 	$mmsrc,r2	# if mmsr then
 #   	bne	mmul2		#   mnmsr(sb) := r1;
 #   	movd	r1,mnmsr(sb)
 #mmul2:	addb	(regtb+3)[r2:d],r0 #r0:=n+regtb.offset
	br	gprex

mmul3:	
	movw	ret0,jmpram+4(sb)	# copy ret 0
  	lshw    $7,r0
   	andw	$0xf87f,jmpram+1(sb)
   	orw	r0,jmpram+1(sb)
	jsr	jmpram(sb)		# jump to ram
   	movd	temp(fp),r1
	br	gprex
 #
 # get put cfg
 #
pcfgl:	movd	r1,r0		# (* move operand to r0 *)
	beq	gcfg		# if getput=put then
	movb	r1,config(sb)	#   config(sb):=r1
	movd	scfgl,jmpram(sb)	#   copy setcfg instruction to ram
	br	mmul3		#   goto mmul2
scfgl:	setcfg	[]		# (* setcfg instructin *)
   	nop			# *** smr x,rn bug ***
gcfg:	movzbd	config(sb),r1	# else r1:=config(sb);
	br	gprex
 #
 # get put memory
 #
gml:	cmpqb	geti,get_put(fp)	# if get then
   	bne	pml		#   clear r1
   	movqd	0,r1
pml:	movd	r1,scrch2(sb)
   	movzbw	(regtb+3)[r2:d],r3# get b w d indicator
	addb	get_put(fp),r3	# r3:= b w d +get_put
gmcase:	casew	gm2[r3:w]	# case of (b w d ) + get_put
gm2:	.word	gb-gmcase	# get byte
	.word	pbx-gmcase	# put byte
	.word	gw-gmcase	# get word
	.word	pw-gmcase	# put word
	.word	gd-gmcase	# get double word
	.word	pd-gmcase	# put double  word
gb:	movb	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
	br	gpre1
pbx:	movb	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gprex
gw:     movw  0(r0),scrch2(sb)    # r1:=m(addr) *** movus ***
	br      gpre1
pw:	movw	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gprex
gd:	movd	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
gpre1: 	movd	scrch2(sb),r1
	br	gprex
pd:	movd	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
gprex:
	exit	[r0,r3]
	ret	5
	#

uart_init:
	#
	cmpqb	1,use_dip(sb)		# check if to get baud rate from
					# dip switch or use 9600 (board 
					# without dip switches)
	bne	uart_init1
	movzbd	@switchp,r2		# read the dip switch
	andb	$0x7,r2			# mask lower three bits for index
	br	uart_init2
uart_init1:
	movqd	0,r2			# else use default baud of 9600
uart_init2:
	movd	$UART,r1		#r1 points to base address of uart
	movb	$0x80,LCR(r1)		#Enable access to divisor latch
	movb	uarttb[r2:w],DLL(r1)	#Divisor latch (LS)
	movb	uarttb+1[r2:w],DLM(r1)	#Divisor latch (MS)
	movb	$0x03,LCR(r1)		#Disable DL access/Setup 8,N,1
	movb	$0x01,FCR(r1)		#activate fifo mode 
	movb	$0x0F,MCR(r1)		#Assert DTR & RTS
	movd	$UART1,r1		#r1 points to base address of uart
	movb	$0x80,LCR/2(r1)		#Enable access to divisor latch
	movb	uarttb[r2:w],DLL/2(r1)		#Divisor latch (LS) (9600 bps)
	movb	uarttb[r2:w],DLM/2(r1)		#Divisor latch (MS)
	movb	$0x03,LCR/2(r1)		#Disable DL access/Setup 8,N,1
	movb	$0x01,FCR/2(r1)		#activate fifo mode 
	movb	$0x0F,MCR/2(r1)		#Assert DTR & RTS
	jump	0(r7)


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

  
    #
nmiint:	save	[r0,r1,r2]		#save working registers
	addr	nmiret,tos		#store return address
	jump	0(vstart(sb))		#vector to correct routine

int0:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+4(sb))		#vector to correct routine
	#
int1:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+8(sb))		#vector to correct routine
	#
int2:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+12(sb))	#vector to correct routine
	#
int3:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+16(sb))	#vector to correct routine
	#
int4:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+20(sb))	#vector to correct routine
	#
int5:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+24(sb))	#vector to correct routine
	#
int6:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+28(sb))	#vector to correct routine
	#
int7:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+32(sb))	#vector to correct routine
	#
int8:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+36(sb))	#vector to correct routine
	#
int9:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+40(sb))	#vector to correct routine
	#
int10:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+44(sb))	#vector to correct routine
	#
int11:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+48(sb))	#vector to correct routine
	#
int12:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+52(sb))	#vector to correct routine
	#
int13:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+56(sb))	#vector to correct routine
	#
int14:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+60(sb))	#vector to correct routine
	#
int15:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+64(sb))	#vector to correct routine
	#
int16:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+68(sb))	#vector to correct routine
	#
int17:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+72(sb))	#vector to correct routine
	#
int18:	save	[r0,r1,r2]		#save working registers
	addr	intret,tos		#store return address
	jump	0(vstart+76(sb))	#vector to correct routine
	#
intret:	restore	[r0,r1,r2]		#restore working registers
	reti				#and return from trap
nmiret:	restore [r0,r1,r2]		#restore working registers
	rett	0			#and return from trap
 #
 #
 # build the interrupt dispatch table in the form of a link table
 #
	.align	4
rinttab:.word	modad
	.word	nvirt-reset
	.word	modad
 	.word	nmirt-reset
	.word	modad
 	.word	abtrt-reset
	.word	modad
 	.word	fpurt-reset
	.word	modad
 	.word	illrt-reset
	.word	modad
 	.word	svcrt-reset
	.word	modad
 	.word	dvzrt-reset
	.word	modad
 	.word	flgrt-reset
	.word	modad
 	.word	bptrt-reset
	.word	modad
 	.word	trcrt-reset
	.word	modad
 	.word	undrt-reset
	.word	modad
	.word	undrt-reset		# 5 dummy entries
	.word	modad
	.word	undrt-reset
	.word	modad
	.word	undrt-reset
	.word	modad
	.word	undrt-reset
	.word	modad
	.word	undrt-reset
	.word	modad

	.word	int0-reset		# the vectored interrupt table
	.word	modad
	.word	int1-reset
	.word	modad
	.word	int2-reset
	.word	modad
	.word	int3-reset
	.word	modad
	.word	int4-reset
	.word	modad
	.word	int5-reset
	.word	modad
	.word	int6-reset
	.word	modad
	.word	int7-reset
	.word	modad
	.word	int8-reset
	.word	modad
	.word	int9-reset
	.word	modad
	.word	int10-reset
	.word	modad
	.word	int11-reset
	.word	modad
	.word	int12-reset
	.word	modad
	.word	int13-reset
	.word	modad
	.word	int14-reset
	.word	modad
	.word	int15-reset
	.word	modad
	.word	int16-reset
	.word	modad
	.word	int17-reset
	.word	modad
	.word	int18-reset

endinttab:
 #
	.align	16
rmodtab:.double	datasp	# start of static base stuff
	.double	intsp	# start of interrupt table
	.double	codesp	# start of code space
	.double 0	# Spare
dend:	.double	0

