 # @(#)monshark.s	1.0	x/xx/xx
 # Copyright (C) 1989 by National Semiconductor Corp.

	.width	130
 #
 #(**********************************************************************)
 #(*									*)
 #(* 	Copyright (c) 1987       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     monshark for Shark/Goldfish evaluation board debug
 #			modified from monQT
 #
 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 #
	.file "monshark.s"
 #
 #  m o n i t o r    i n t e r r u p t s    &   t r a p s.
 #
 #
	.globl	reset,berrt
	.globl	msgent,erent,getput,sprinta,srdlin
	.globl	printa,rdlin,hxtobn,bntohx,mainlp
	.globl	hexan
	.globl	mnexit,bptrt,trcrt,nmirt,abtrt,nvirt
	.globl	fpurt,illrt,mdvzrt,flgrt,undrt,svcrt

#include "def.s"

 #
 #
 #
 #   r e s e t    r o u t i n e
 #
.text
.align 4
reset::
_main::
#ifndef RAM
	br	gorom+prom_start	# jump to 'real' prom location
gorom:	
#ifdef  DRAGON
	movqb	$0,sycfg		# config reg
	movqb	$0,pidat		# data port = 0 (switch off overlape)
	movb	$0xc,picfg		# set port to output
#endif /* DRAGON */
#ifdef CG160 
	movb	$led_P, led		# enable RAM, put 'P' on LED
#endif 
#ifdef	SWIFT
	movqw	$0, cfr			# Write enithing to CFR in order to 
					# turn off SHADOW BIT.
					# use 2 Mbit EPROM
					#     3 wait states on all EPROM
#endif
#endif	/*  RAM */
	addr	ui_rtn, r7		# init uarts (ram overlay,etc)
	br	serial_init
ui_rtn:
	addr	size_rtn, r7		# size ram, value returned in r4
	br	size_ram
size_rtn:
	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	SWIFT				
					# Default: start with NON-DE mode
	addr	inttab,r1		# get interupt dispatch table address
					# from prom
#else
	addr	dinttab,r1		# On Swift Only DE mode aloud
#endif

#ifndef	RAM
	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:= 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 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:
	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.

	INIT_CFG
	movzbd	@switchp, r3		# check bit 6 on dip switch
	tbitb	$demo_bit,r3
#ifndef	DRAGON
	bfc	nodemo			#  
#else
	bfs	nodemo			#  
#endif
	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:

 	#movd	$0x00,svcfg(sb)
	#setcfg	[]

	bsr     mainlp			# type monitor reset message
begina:

	.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 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
	lprw	psr, $0x0

	PRINT_SB	svsb(sb)	# update sb save register

	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
        addr    stackl - 4(sb),r1               # sp:=address of stack erea
        lprd    sp,r1                   #   ( sp:=sb+stackl)
        addr    term1(sb),r7            # dtrm:=term1

	lprd    fp,mnfp(sb)		# load monitor fp
	movd    scrch2(sb),0(sp)	# put return address on stack


 mnentr3:				#   end;

	addr    outb(r7),r6		# init dtrm.outb
	movqb	false,mcrwf(sb)		# mcrwf := false {for monitor time abt}
	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
	nop
	movb  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
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}
 mnext1: 
        RESTORE_SB			# load user sb (this have an efect only
					# in direct exception mode)
 mnret:
#ifdef	CG160
	movb	$led_run, led		# put an 'r' (sort of) on LED
#endif
	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
	RESTORE_SB
	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
	nop
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 
	movb	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
	nop
	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:	
        bicpsrw $0x800                  # Disable interrupts 
	SAVE_SB				# save sb register
	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:
        bicpsrw $0x800			# Interrupt disable
	SAVE_SB				# save sb register
        movqb	pndmod,mon_usr(sb)	#	pending interrupts flag on.

 #	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}
 #	rcm0:	
 #	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)	# don't remove breakpoints
	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
	movb  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 pennding.
	br	error3
trc6:	
	bsr	mnexit			#	  else return to user
 
 #
 #  n m i     r o u t i n e
 #

nmirt:  
	SAVE_SB				# save sb register
 	bsr     mulpnd			# multich; {check pennding mode}
	movb	$enmi,errtyp(sb)
	cmpqb   mont,mon_usr(sb)	#if uset time error(nmi)
	bne     error4
	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:=1}


Et_nmi:
        movw    $'R'+0x100*'N',0(r6)    #   " rn"
        addqd   2,r6                    #    outbuf:= "rn"
	bsr	sprinta
	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
	br      mainlp			# end

 #
 #  a b o r t   r o u t i n e
 #

abtrt:
	SAVE_SB				# save sb register
 #	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

 # 
 #	D B G trap routine
 #

mdbgrt:	
        bicpsrw $0x800
	SAVE_SB				# save sb register
 	bsr     mulpnd			# multich; {check pennding mode}
        movb    $edbg,errtyp(sb)	# error dbg
        cmpqb   mont,mon_usr(sb)	# user time?
	bne	error4        		# no, print error.
        movqb   1,ackflg(sb)		# yes, ackflg = nmi
        bsr     mainlp			# get next inst

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

 #
 # s v c   r o u t i n e s
 #
#ifdef	DE_CMD
	svclm:	.byte	14,3
#else
	svclm:	.byte	13,3
#endif

svcrt:	
#ifdef  SAFE_SVC
        bicpsrw $0x800
#endif
	SAVE_SB				# save sb register
	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:	
	movqb	1,force_serial(sb)	# flag to force serial link
	movw	r2,tos
	movw	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
	tbitd	$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	error4			# else
svcex1:	
	movb	monusr1(sb),mon_usr(sb)	# flage user time
	RESTORE_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:	
	movqb	1,force_serial(sb)	# flag to force serial link
	movd	r1,tos			# printa (r1,r1+r2,r3)
	movd	r2,tos
	addd	r1,tos
	movzbd	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	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:	
	movb	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 endf
 	tbitd	$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
	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)
	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
	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		# if code not 5555555 error
	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:	
#ifdef	CG160
	cmpd	$0x55555555,r1		# if code not 5555555 error
	bne	svcer
	cmpqd	$0,r2
	bne	mdirexp
	addr	inttab,r3
	lprd	intbase,r3
	movd	r3,rstint(sb)		# save new intbase for reset 
					#   intbase command.

	movzbd	@switchp,r1		# use bits 4 5 on DIP 
					# switch for cfg seting
	comb	r1,r1
	andb	$0x30,r1
	lshb	$-4,r1
	movw	r1,svcfg(sb)		#   config:=r1
	bsr	lprw_cfg_r1
	br	svcex
 mdirexp:
	cmpqd	$1,r2
	bne	svcer
	addr	dinttab,r3
	lprd	intbase,r3

	movzbd	@switchp,r1		# use bits 4 5 on DIP 
					# switch for cfg seting
	comb	r1,r1
	andb	$0x30,r1
	lshb	$-4,r1
	sbitw	$cfg_de,r1
	movw	r1,svcfg(sb)		#   config:=r1
	bsr	lprw_cfg_r1
#endif	/* CG160 */
	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

 #
 #  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

error2: 
	SAVE_SB				# save sb register
	movb	tos,errtyp(sb)		# get error type
error4:
	bsr     mnentr			# save user status load monitor status
	br	err33
error3:	
	bsr 	brkrmv			# brek points rem
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
erent:
	movd	r7,r6
	movb    $'E',0(r6)  		#  insert e
	movxbd  r1,r1
	nop
	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'
 #	.byte   'M','C'    ,'M','M'
 #	.byte   'M','S'    ,'T','E'
 #	.byte   'P','T'	   ,'I','V'    
	.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 register which is r,f,l
	.set    mstart, (regend-regntb)/2
	.set	lregno, (regend-regntb)/2-1

 #
 # monitor commands table
 #

cmndtb: 
	.byte   'M',' '    ,'F',' '
	.byte   'S','R'    ,'L',' '

	.byte	'D','E'	   

cmdu:	
	.byte   'D',' '    ,'S','U'
cmsw:	
	.byte   'S','W'    ,'J','S'
	.byte   'C','X'    ,'G',' '
	.byte   'S','T'    ,'O','M'
cmp:
	.byte   'P',' '    ,'C',' '
	#.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)
	.byte	'V','R'
	.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

rmsg:	
#ifdef CG160
	.ascii	"R GNX MONITOR (MONCG160) VERSION 4 REV 2 RAM:0 - "
#endif
#ifdef DRAGON
	.ascii	"R GNX MONITOR (MONFX16FAX) VERSION 4 REV 2 RAM:0 - "
#endif
#ifdef SWIFT
	.ascii	"R GNX MONITOR (SWIFT) VERSION 4 REV 2 RAM:0 - "
#endif
rmsge:
et_msg:
	.ascii	" ETHERNET CONNECTION"
et_msge:

mainlp:
#ifdef	CG160
	movb	$led_E, led		# display 'E' on LED display
#endif
	addr    outb(r7),r6		# dtrm.outlm:=2
	#movb	$cr,0(r6)
	#addqd	1,r6
	movxbd  ackflg(sb),r3
procs:	
	casew	protb[r3:w]		# case of ackflg :
protb:	
	.word	pro0-procs
	.word	pro1-procs
	.word	pro2-procs
	.word	pro3-procs
pro0:	
	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	ETHERNET
 	movzbd	@switchp,r1		# Get the jumper setting
#ifndef	RAM
 	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
	bsr	sprinta
					# else Use ethernet.
#endif	/* not def RAM */
	movzbd	@switchp,r1
	andd	$1,r1			# extract thin /thick bit
	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.
#endif  /* ETHERNET */
pro01:
 ###

	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)
	br	mread:b
pro3:	
 	movb	$'*',0(r6)
	addqd	1,r6
 	bsr	sprinta
mread:
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
	cmpb	$3,ackflg(sb)		# check if ethernet
	beq	fscn			#	    then go to fscn
 #  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(sb) < 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:  
	cmpb    $'!',0(r5)	      	#   if chr="!"
	beq	mainlp
	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
	.double   mdumplp-maincs	# dump
	.double   stulp-maincs		# step untile
	.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
	#.double	  cacheinv-maincs	# cache invalidate
	.double	  blcmd-maincs		#  begin fast downloading
	.double	  elcmd-maincs		#  end of fast downloading
	.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)
	.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:
	jsr     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:
	jsr     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

 #	.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

	.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
	nop
	cmpqb	one_reg,gptbl[r2:d]	# if only one reg - no more parms
	beq	gorp
	bsr	shxtobn			# get hexa number - trans to bin
	nop
	cmpqb	mem_gp,gptbl[r2:d]	# is it memory address ?
	beq	gorp			# yes - go to print or change
	nop
	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
 #

	nop
	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
	nop
	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)
	movb	$'=',0(r6)		# enter '=' to output buffer
	addqd	1,r6
	movd	r1,tos
	nop
	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
	nop
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
	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
	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)
	movb	scrch2(sb),0(r1)	#     if not written  then
        #sprd    cfg,tos             
        #lprd    cfg,$0
        #lprd    cfg,tos
	movb	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) (ignore 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 modes)
	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)
	CHANGE_SB 0(r2)			#    sb := read sb
	movd	8(r2),scrch2(sb)
	addd	scrch2(sb),r1
	addqd   -4,r0
	movd	svmod(sb),scrch1(sb)	# get mod
	movd	scrch1(sb),0(r0)	# write it on stack
	movd	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
	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=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) ;
	nop
	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
	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:	
	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)
	nop
	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[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:	
	movb	0(r5),0(r0)
	movb	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
 
 #
 #	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 "
#ifndef SWIFT				/* Only TR0 on SWIFT	    */
	movqb	1,r4			#    then  term:=1;
#endif
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 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,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: 
	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);
	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:	
	movb	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:	
	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),-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, return to mainlp
	beq	sperr			# else
	br	mainlp
sperr:	
	movd	$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),-4(sp)
	cmpw	scrch2(sb),-4(sp)
	br	spcf
filld:	
	addqd	3,tos			#	     step:=step+3;
	movd	scrch2(sb),0(r0)	#     "d"    m(destination-addr):=x;
srchd:
	movd	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:
	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	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
	nop
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:	
#ifndef	SWIFT
	movqb	transp,opmod(sb)	# opmod := transparent
#else
	br	synterr			# No transparent mode on SWIFT
#endif
opt2:	
	movb	r1,ophnd(sb)		# hand-shake flag := r1
	movqb	2,ackflg(sb)		# set mode to serial
	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
#ifndef	 SWIFT
        addr    inttab,r3
#else
	addr	dinttab,r3
#endif
        lprd    intbase,r3
#ifdef	CG160
        movzbd  @switchp,r1             # use bits 4 5 on DIP 
                                        # switch for cfg seting
        comb    r1,r1
        andb    $0x30,r1
        lshb    $-4,r1
        movw    r1,svcfg(sb)            #   config:=r1
        bsr     lprw_cfg_r1
#endif	/* CG160 */
#endif
newbrk:	
	br	mainlp


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

exceptd:
#ifndef DE_CMD
	br	synterr
#else
	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
	movd	svcfg(sb),r1
	bsr	lprw_cfg_r1		# emulate lprw	cfg,r1
        #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
	movd	svcfg(sb),r1
	bsr	lprw_cfg_r1		# emulate lprw	cfg,r1
        #lprd    cfg,svcfg(sb)
	addr	dinttab,r1		# get direct exception intbase value
exexp:	
	lprd	intbase,r1		#  load intbase reg with new value
	#movd	r1,rstint(sb)		# save value for reset intbase
	br	mainlp	
#endif /* DE_CMD */
 
 #
 # 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
 #  end

verhd:
#ifdef CG160
	.ascii	" GNX MONCG160 4.2 creation time:"
#endif
#ifdef	DRAGON
	.ascii	" GNX MONFX16FAX 4.2 creation time:"
#endif
#ifdef	SWIFT
	.ascii	" GNX SWIFT 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 chars in input line

srdlin:

	enter	[r0,r1,r2],0    	# 
	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		# 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
	nop				# shark rev a walk around 
	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
	nop				# shark rev a walk around 
	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 line 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:	
#ifdef	ETHERNET
	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	6
rd_serial:
#endif
	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
	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}
	movb	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
#if (defined (CG160) || defined (DRAGON))
 #
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	$0x200000,r2		#  set timeout count
rdchrlp:				# do while in_rdy=0 and rd_wait=true
	#tbitd	$in_rdy,ls_reg(r1)	#   input in_rdy
	tbitb	$in_rdy,ls_reg(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	datap(r1),rd_chr(fp)	# rdchr:=usart data
	movqb	true,rd_wait(fp)	# rd_wait:=true
rdchrex:
	exit	[r1,r2]
	ret	2
#endif
#ifdef	SWIFT
rdchr:	
	enter	    [r0,r1,r2,r3],0
	addr	    scc0,r1		# r1 = scc0 (Only one port on swift)
	movd	    $0x200000,r2	#  set timeout count
rdchrlp:				# do while in_rdy=0 and rd_wait=true
	read_reg    r1,0,r3
	tbitb	    $in_rdy, r3		#   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:
	read_reg    r1, 8, r3
	movb	    r3, rd_chr(fp)	# rdchr:=usart data
	movqb	    true,rd_wait(fp)	# rd_wait:=true
rdchrex:
	exit	    [r0,r1,r2,r3]
	ret	    2

#endif	/* SWIFT */
 
 #
 #	 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
	nop
	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
	nop
	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
	nop
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	ETHERNET
	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
	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
	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)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
prnx2:	
	movb	$true,tos		# go to exit
 #prnx2: movb	$false,tos		# go to exit
	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
 #

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			# cnvrt length to hex and put into buf
 	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


#if (defined (CG160) || defined (DRAGON))
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,ls_reg(r1)	# if tx-rdy = 0
	tbitb	$out_rdy,ls_reg(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),datap(r1)
	movqb	true,wait_pr(fp)	# else write(data-port,chr)
prchrex:
	exit	[r1,r2]
	ret	3

#endif
#ifdef	SWIFT
prchr:	
	enter	    [r0,r1,r2],0
	addr	    scc0,r1
prchrlp:
	read_reg    r1, 0, r2
	tbitb	    $out_rdy,r2		# 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),r2
	write_reg   r1, 8, r2
	movqb	    true,wait_pr(fp)	# else write(data-port,chr)
prchrex:
	exit	[r0,r1,r2]
	ret	3


#endif	/* SWIFT */
 
 #
 #	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)
	nop
	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
	nop
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
	nop
srchl:	
	cmpw	0(tabadr(fp))[r2:w],0(r5)
	beq	srfnd			#  if tab(i_i+1)<>inbuf(i_i+1)
	nop
	cmpb	0(tabadr(fp))[r2:w],0(r5)	# then if tab(i)=inbuf(i)
	bne	src2			#  then
	nop
	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
	jsr	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,mcr,eadd,ptb,pf,
 #		   sc,bpr,bcnt,real-mcr,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	mmcrc,7			# mmcr 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
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

 #	.word	gpmcr-lgp		# mcr
 #	.word	gpmmcr-lgp		# mmcr
 #	.word	gpmsr-lgp		# msr
 #	.word	gptear-lgp		# tear
 #	.word	gppt-lgp		# ptb
 #	.word	pivar-lgp		# ivar

	.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
	PRINT_SB	r1		# get user sb
	br	gpex
psb:	
	CHANGE_SB	r1		# put user 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 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


 #
 #  get put cfg
 #

gpcfg:	cmpqb	$geti,get_put(fp)	#  set cc if operation is get
 	beq	gcfg			# if getput=put then
 #	lprd    cfg,r1
 #	sprd    cfg,svcfg(sb)
	andw	$0x10f,r1		#   set only relevanr bits
#ifdef	SWIFT
	sbitw	$cfg_de,r1		#   Force de bit
#endif
	movw	r1,svcfg(sb)		#   config:=r1
	bsr	lprw_cfg_r1
	movd	temp(fp),r1
	br	gpex


lprw_cfg_r1:

	movd	scfgl,jmpram(sb)	#   copy setcfg instruction to ram
	movw	ret0,jmpram+4(sb)	# copy ret 0
   	lshw    $7,r1
   	andw	$0x787f,jmpram+1(sb)
   	orw	r1,jmpram+1(sb)
	jsr	jmpram(sb)		# jump to ram
	ret	0
	
	
scfgl:	setcfg	[]			# (* setcfg instructin *)
	nop
ret0:	ret	0			# ret 0 instruction

 #	br	gpex

gcfg:   
 #	sprd    cfg,r1
	movzwd	svcfg(sb),r1		# else r1:=config;

	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:	movb	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
	br	gpre1
pmb:	movd	r1,scrch2(sb)
	movb	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)
	movw  0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
	br      gpre1
pmw:	movd	r1,scrch2(sb)
	movw	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
	movd	0(r0),scrch2(sb)	# r1:=m(addr) *** movus ***
gpre1:	movd	scrch2(sb),r1
	br	gpex
pmd:	movd	r1,scrch2(sb)
	movd	scrch2(sb),0(r0)	# m(addr):=r1 *** movsu ***
	br	gpex
 #
gpbrl:	movd	n_gp(fp),r0
	cmpqb	$geti,get_put(fp)
	bne	pbrl
	nop
	movd	(brkar-8)(sb)[r0:d],r1	# get break point address
	br	gpex
	nop
pbrl:
	andd	$0xffffff, r1		# mask lower 24 byte
	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


#if (defined (CG160) || defined (DRAGON))
 #
 # 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.

serial_init:
 	movb	$0x80, uart0+lc_reg	# enable divisor latch, ch. 0
 	movb	$0x80, uart1+lc_reg	# enable divisor latch, ch. 1
#ifdef	DRAGON
	movb    $0x41, @mwctl           # Write to MW control
	MW_DO   $0x12                   # Config I/O pins
	MW_DO   $0xf0                   # I/O pins = OOOOIIXX
	MW_DO   $0x0e                   # Read I/O pins
	MW_DO   $0x00                   # Dummy command
	movzbd  @mwdat,  r2
	tbitb   $baud_bit,  r2          # get baud rate selection
	sfsb    r2 
#else
	movzbd	switchp, r2		# get baud rate selection
#endif
	andb	$baud, r2		# mask lower bits for index
 	movb	uarttb[r2:w], uart0+dl_low	# extract baud constants, store
 	movb	uarttb+1[r2:w], uart0+dl_high	#  to uarts.
 	movb	uarttb[r2:w], uart1+dl_low
 	movb	uarttb+1[r2:w], uart1+dl_high
 	movb	$0x03, uart0+lc_reg	# set 8 bits, 1 stop, no parity
 	movb	$0x03, uart1+lc_reg	# set 8 bits, 1 stop, no parity
		#movb	$0x00,uart0+fifo_cntl	#  no fifo
		#movb	$0x00,uart1+fifo_cntl	#  no fifo
		movb	$0x01,uart0+fifo_cntl	#  use fifo
		movb	$0x01,uart1+fifo_cntl	#  use fifo
		movb	$0x00,uart0+ien_reg	# no interrupts
		movb	$0x00,uart1+ien_reg	# no interrupts
 	movb	$0x0f, uart0+mc_reg	# init modem register/reset
 	movb	$0x0f, uart0+mc_reg	# init modem register/reset
 	#movb	$0x0b, uart1+mc_reg	#   ram overlay (OUT1 of uart0)
 	#movb	$0x0b, uart1+mc_reg	#   ram overlay (OUT1 of uart0)
 	movb	uart0+datap, r4		# flush uarts
 	movb	uart1+datap, r4
	jump	0(r7)			# return

#endif

#ifdef	SWIFT
    #
    #	This routine initialize the Z8530 SCC port A
    #	Since the SWIFT board dose not support two port usage NO TRANSPARENT!!
    #
    
serial_init:
        movd        $CHA, r1		    # R1 points to channel A register
        write_reg   r1, 9, $0xc0            # Reset the SCC
        write_reg   r1, 4, $0x44            # Select Clock mode *16, 
					    # One stop bit, No parity
        write_reg   r1, 3, $0xc0            # Recieve 8 bits Recieve disabled
        write_reg   r1, 5, $0xe2            # Transmit 8 bits Activate RTS,DTR
					    # Transmit disabled
        write_reg   r1, 9, $0x0             # Interrupt disable
        write_reg   r1, 10, $0x0
        write_reg   r1, 11, $0x56           #***
	movzbd	    switchp, r2		    # get baud rate selection
	andb	    $baud, r2		    # mask lower bits for index
 	movb	    uarttb[r2:w], r3
        write_reg   r1, 12, r3		    # load divisor into SCC
	
 	movb	    uarttb+1[r2:w], r3
        write_reg   r1, 13, r3		    # load divisor into SCC
        write_reg   r1, 14, $0x0	    #***
 
        #       
        # ENABLE the SCC
        #
        write_reg   r1, 14, $0x1	    #***
        write_reg   r1, 3, $0xc1            # Recieve 8 bits Recieve enabled
        write_reg   r1, 5, $0xea            # Transmit 8 bits Activate RTS,DTR
	jump	    0(r7)

#endif

 #############################################################################
 #
 #              size_ram:
 #
 #              global ram size test return size of on board ram under the 
 #              following assumptions:
 #              1) Ram memory starts at *ram_start* and is continus.
 #              2) Minimum ram block is 64KB.
 #              3) On end of ram block one of the following two might ocure:
 #                  A.  Memory write fails.
 #                  B.  Memory is overlapd to address *ram_start*
 #                      (Next memory window)
 ############################################################################
size_ram:
	addr	ram_start, r4		# init pointer register
	movb	$0x0, 0(r4)		# clear the location
	movqd	$0,@ram_start + 4	# Initialize memory location for 
					# R/W cycles  to discharge bus upon 
					# writing to non existent address.


size_lp:
	addd	$0x10000, r4		# Increment pointer
	movb	$0x55, 0(r4)		# init first location
	addqd	$1, @ram_start + 4
	cmpb	$0x55,0(r4)		# Check if data writen
	bne	size_end
	movb	$0xaa, 0(r4)		# init first location
	addqd	$1, @ram_start + 4
	cmpb	$0xaa,0(r4)		# Check if data writen
	bne	size_end
	cmpb	$0xaa,@ram_start	# Check for memory overlapping
	beq	size_end
	br	size_lp
size_end:
	jump	0(r7)

	
#ifndef	 SWIFT				/* Support Only DE mode	    */

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

.align 4

inttab::	
	.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	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

#endif	/* ndef SWIFT */
 #
 # build the interrupt dispatch table in pc relative (direct exception)
 # form.
 #
#if (defined(DE_CMD) || defined (SWIFT))
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
#endif
 #
 # Baud rate conversion table.  Setting of SW1 bits 0-3 serve
 # as index into table.  Table holds value to be loaded into 
 # 16552 divisor latches.  UART master clock = 16.000 MHz.
 # 
 # The setting of '0000' in the least significant bits of the
 # configuration switch is a special case.  This will indicate
 # that the ethernet board is active and the two serial channels
 # are set for 9600 baud operation.
 #

#ifdef	DRAGON
uarttb:	
	.word	10,5			# 9600, 19.2K
#endif
#ifdef	CG160
uarttb:	
	.word	104			# special case 9600, see above
	.word	104,26,52		# 9600, 38.4K, 19.2K
	.word	104,208,417,833		# 9600, 4800, 2400, 1200
	#.word	556,833,1667,3333	# 1800, 1200, 600, 300
	#.word	6667,9091,13333,20000	# 150, 110, 75, 50
#endif
#ifdef	SWIFT
uarttb:	
	.word	10,4			# 9600, 19.2K
#endif

 #
 # mod table
 #


modtab:	
	.double dataad
	.double	0
	.double	reset
	.double	0

prom_end:
	.double	0
