;-*- MIDAS -*-

title CHATAB -- print information on CHAOS hosts

x=:0
a=:1
b=:2
c=:3
d=:4
e=:5
t=:10
tt=:11
bp=:12
hstc=:13
tyoc=:14
p=:17

call=:pushj p,
ret=:popj p,

nw%lcs==:22			;LCSnet
nw%dln==:26			;Dialnet


$$ARPA==1			;Hack the ARPAnet
$$CHAOS==1			;Hack the CHAOSnet
$$ALLNET==1			;Lookup routines will handle any host
$$HOSTNM==1			;Host name lookup routines
$$SYMLOOK==1
$$HSTMAP==1
hstpag==:50			;Page to put host table on
hsttab=:hstpag*2000

pat::
patch:	block 100

.insrt syseng;netwrk >

popj1:	aos (p)
cpopj:	ret

define SYSCAL op,args
       .call [setz ? sixbit /op/ ? args((SETZ))]
termin

define TYPE &str
	movei bp,[asciz str]
	call typstr
termin

;Type an ASCIZ string
typstr:	hrli bp,440700
typst0:	ildb t,bp
	jumpe t,cpopj
	.iot tyoc,t
	jrst typst0

pdl:	-100,,pdl
	block 100

jclbuf:	block 100
	-1

go:	move p,pdl		;Set up PDL
go1:	movei a,hstpag		;Page to put
	movei b,hstc		;channel to use to load
	call netwrk"hstmap	;Map in HOSTS2
	  jrst failed
	syscal OPEN,[%clbit,,.uao ? %climm,,tyoc ? [sixbit /TTY/]]
	  .lose %lsfil
	move d,hsttab+netwrk"netptr  ;Get ptr to network table
	move t,hsttab(d)	   ;get # of entries
	move tt,hsttab+1(d)	   ;Get size of entries
	movei d,2(d)		   ;first network table entry
	movei a,netwrk"nw%chs
netlop:	camn a,hsttab+netwrk"netnum(d)	   ;Is this the CHAOS network?
	  jrst netfnd		   ;  yep
	add d,tt		   ;Next entry
	sojg t,netlop
	.lose

netfnd:	hrrz d,hsttab+netwrk"ntrtab(d)	;Get address-table ptr
	move b,hsttab(d)	   ;get # of entries
	move c,hsttab+1(d)	   ;get size of entries
	movei d,2(d)		   ;Get ptr to first entry
chalop:	hlrz a,hsttab+netwrk"adlsit(d)	;Get SITE table entry
	hlrz bp,hsttab+netwrk"stlnam(a)	;Get ptr of name
	movei bp,hsttab(bp)	   ;get core address of name
	call typstr		   ;type the name
	type /  /
	hrrz bp,hsttab+netwrk"strmch(a)	;Get machine name
	skipn bp
	  movei bp,[asciz /Unknown/]-hsttab
	movei bp,hsttab(bp)
	call typstr
	.iot tyoc,["/]
	hlrz bp,hsttab+netwrk"stlsys(a)
	skipn bp
	  movei bp,[asciz /Unknown/]-hsttab
	movei bp,hsttab(bp)
	call typstr
	type /  /
	movei bp,[asciz /(SERVER)/]
	skipl hsttab+netwrk"stlflg(a)
	  movei bp,[asciz /(USER)/]
	call typstr
	
	move a,hsttab+netwrk"addadr(d)	;Get address
	setz x,			   ;Clear network #
	dpb x,[netwrk"nw$byt,,a]

	type / = /

	call octtyp
	type /   /
	ldb a,[101000,,hsttab+netwrk"addadr(d)]
	call octtyp
	type \/\
	ldb a,[001000,,hsttab+netwrk"addadr(d)]
	call octtyp

chanxt:	type /
/
	add d,c			   ;Next address
	sojg b,chalop
	.logout 1,

octtyp:	move t,a
octpnt:	setz tt,
	lshc t,-3		   ;shift instead of IDIVI, don't forget
	lsh tt,-41		   ;negative! 
	push p,tt		   ;push remainder
	skipe t			   ;done?
	  call octpnt		   ;no compute next one

octpn1:	pop p,tt		   ;yes, take out in opposite order
	addi tt,60		   ;make ascii
	.iot tyoc,tt
	ret			   ;and return for the next one.

failed:	type /Lookup failed.
/
	.logout 1,
end go