;-*- Midas -*-
	title RMTDEV - MLDEV for non-ITS hosts

ifndef dbgsw,dbgsw==0

;;July 1985, GZ

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7
j=:10
k=:11
v=:12
w=:13

F=:14			;Flags

U=:15			;AC munged at interrupt level
INT=:16			;Interrupt-p flag, in AC for more efficient .hanging

p=:17
call=:pushj p,
ret=:popj p,
nop=:jfcl
callret==:jrst

;Twenex-style label-generating macros.
.insrt midas;macsym

define syscal name,args
	.call [ setz ? sixbit/name/ ? args ((setz))]
termin

define fallto label
 if2,ifn .-label,.fatal fallto label not falling to label 
termin

define note &text
ifn dbgsw,[
	call [call $note
	      .length text
	      ascii text]
]
.else jfcl
termin

define nout loc
ifn dbgsw,[
	call [call $nout
	      loc]
]
.else jfcl
termin

define nsix loc
ifn dbgsw,[
	call [call $nsix
	      loc]
]
.else jfcl
termin

define nstr loc
ifn dbgsw,[
	call [call $nstr
	      loc]
]
.else jfcl
termin

chboj==:1
chusr==:2
chneti==:3
chneto==:chneti+1
chtyo==:chneto+1	;For debugging output

;;Flags in RHS of F.  (LHS of F has the open mode)
f%pclsr==:000001	;Our last JOBRET failed so expect a restarted call.
f%open==:000002		;Creator has file open.
f%eofi==:000004		;Have reached end of input from net
f%clss==:000010		;Sent close request, don't leave til get a reply
f%dnrf==:000020		;Device was xxDNRF:
f%blka==:000040		;Open in block ascii mode
f%dbug==:000100		;Debug mode
f%conn==:000200		;Have a connection
 f%dir==:000400		;doing a directory listing
;Flags that say that interrupts happened and are awaiting mp level processing.
fi%boj==:100000
fi%nti==:200000
fi%nto==:400000

.insrt dsk:system;chsdef
;;Special Chaosnet Packet Opcodes
;;Opcodes 200-217 are data. The 10 bit means this is eof.  The last 3 bits
;;give the number of padding bits in the last byte of the packet, so we can
;;transmit exact numbers of bits.  All data is transmitted in FTP-like image
;;mode (i.e. as a bit stream of relevant bits).
%COLST==:210		;Last (EOF) packet of file
%COMND==:220		;A command
%CORPL==:221		;A reply to a command
%COASY==:222		;Asynchronous error from server.

;Dunno, MLDEV uses 10, FCDEV uses 20...
WINDOW==:10		;Net window size

chnl==:200\^M		;Chaosnet newline character

;;%COMND/%CORPL opcodes
r.opno==:0			;Output open
r.opni==:1			;Input open
r.dirl==:2			;List directory
r.renm==:3			;Rename
r.dele==:4			;Delete
r.expu==:5			;Expunge
r.crdi==:6			;Create directory
r.mlnk==:7			;Make link
r.reu==:10			;Reuse

r.cls==:20			;Close
r.alc==:21			;Input allocation
r.acc==:22			;Access
r.rnmw==:23			;Rename while open
r.delw==:24			;Delete while open
r.srd==:25			;Set Reference Date
r.sfd==:26			;Set File write Date
r.saut==:27			;Set file Author
r.rsts==:30			;Read file status
r.srpb==:31			;Set File Reap Bit

;;JOBCAL argument definitions

;JOBCAL words for OPEN
J.FN1==:1		;First filename
J.FN2==:2		;Second filename
J.SNM==:3		;Sname
J.DEV==:4		;Device
J.MOD==:5		;Open mode
J.FNM==:7		;String-filename pointer, or 0 if only sixbit

;JOBCAL words for IOT
J.PTR==:0		;IOT pointer

;JOBCAL words for SIOT
J.CNT==:0		;Byte count

;JOBCAL words for ACCESS
J.PTR==:0		;ACCESS pointer

;JOBCAL words for MLINK
J.TFN1==:0		;Target (linked-to) first filename
J.FN1==:1		;Source (link's) first filename
J.FN2==:2		;Source second filename
J.SNM==:3		;Source sname
J.DEV==:4		;Source device
J.TFN2==:5		;Target second filename
J.TSNM==:6		;Target sname
J.FNM==:7		;Source string-filename pointer or 0
J.TFNM==:10		;Target string-filename pointer or 0

;JOBCAL words for FDELE (rename/delete)
J.TFN1==:0		;Target (new) first filename, or 0 if delete
J.FN1==:1		;Source (old) first filename
J.FN2==:2		;Source second filename
J.SNM==:3		;Source sname
J.DEV==:4		;Source device
J.TFN2==:5		;Target second filename, or 0 if delete
J.FNM==:7		;Source string-filename pointer
J.TFNM==:10		;Target string-filename pointer

;JOBCAL words for FDELEWO (rename/delete while open)
J.TFN1==:0		;Target (new) first filename, or 0 if delete
J.TFN2==:5		;Target second filename, or 0 if delete
J.TFNM==:10		;Target string-filename pointer

;JOBCAL words for CALL
J.CAL==:0		;Sixbit call name
J.CTB==:1		;Control bits
J.ARGC==:2		;Count of arguments
J.ARG1==:3		;First arg
J.ARG2==:4		;Second arg
J.ARG3==:5		;Third arg
			;....

	subttl variable definitions

loc	42
	jsr tsint
loc	77
	sixbit /MLDEV/		;The pretender...

rdevn:	block 4	;Filename for JOBSTS (and nominally RCHST)
raccp:	0	;Access pointer, must follow RDEVN block for RCHST.
opmode:	0	;Mode from OPEN call (for JOBSTS)
crunam:	0	;Creator's UNAME
crjnam:	0	;Creator's JNAME

;;Next four must be in this order (for FILLEN .call)
fillen:	0	;File length in BYTSIZ bytes or -1 if unknown (unknowable).
bytsiz:	0	;Byte size open in, 7 for unit ascii, otherwise 36.
filbln:	0	;File length in bytes of size written in
filbsz:	0	;Byte size file written in

;Hope nobody snoops beyond this point...

debug:	0

pat:
patch:	block 100
patche:	-1

;;Random file properties.
.scalar fildat	;File creation date in universal time or 0 if unknown.
.scalar filref	;File reference date in universal time or 0.
.scalar filaut	;Author's name in sixbit or 0.

;;Data returned by JOBCAL.
.scalar jbcop			;JOBCAL Opcode
.scalar jbc(jbclen==:13)	;JOBCAL Arguments

;;Variables for buffer management
.scalar bufsiz	;Total buffer size in BYTSIZ bytes
.scalar bufcnt	;Number of BYTSIZ bytes available to user for reading/writing
.scalar bufptr	;Pointer into buffer for user<->buffer communication.
		;In block mode, it's the address of next word to read/write
		;In unit mode, it's a byte pointer.
.scalar bufptn	;Count of BYTSIZ bytes from BUFPTR to BUFEND
.scalar netptr	;Pointer into buffer for net<->buffer communication.
		;RH has address of next word, LH has number of bits in
		; that word still available to user (and hence not to net)
.scalar alcptr	;On input, address of first unallocated word in BUF
.scalar alccnt	;Number of allocated bits not received yet.

;;Variables for image mode packet<->buffer conversion
.scalar wdlen	;Number of bits in each buffer word (35 if ascii, 36 if image)
.scalar fudge	;wdlen-32 (32=number of bits in each packet word)

;;Handling of net commands
.scalar seqnum	;Transaction counter
.scalar rplseq	;Number of reply that we're waiting for, or -1 if not waiting
.scalar accseq	;Number of access command outstanding, or -1 if none.

.scalar iotcnt	;If non-zero, number of bytes remaining in a hung IOT
		;On input, IOT hung because data still not available.
		;On output, because we stopped to read some net reply packets.

fnmstl==:100		;Max length of filename
.scalar trunam(fnmstl)	;Truename of file, from the server
.scalar sysnam(fnmstl)	;Permanently the truename of file, for JOBSTS

.scalar fdevn		;Foreign device name from initial open device name.
.scalar fhost		;Foreign host name from initial open device name.
.scalar fhostn		;Foreign host number

.scalar pktbuf(%cpmxw)	;Chaos packet buffer.

pdllen==:100
.scalar pdl(pdllen+4)	;Guess

	subttl Initialization and top-level loop

begin:	move p,[-pdllen,,pdl-1]
	setz f,			;Clear flags
ifn dbgsw,[
	.suset [.roption,,a]
	tlnn a,%opddt
	ifskp.
	  txo f,f%dbug
	  tlo a,%opojb
	  .open chtyo,[.uao\%tjdis,,'tty ? setz ? setz]
	   .lose %lssys
	  .value [asciz ""]
	  .suset [.soption,,a]
	  note "AHere we go..."
	endif.
]
	.suset [.smask,,[%piioc+%piilo+%pimpv+%pipdl]]
	.open chboj,[30\.bio,,'boj]	;20=don't hang, 10=one way.
	 die
	syscal rfname,[%climm,,chboj ? %clout,,a
		       %clout,,crunam ? %clout,,crjnam]	;Names for PEEK
	  nop
	.call jobcal		;Get first call
	 die
	note "[initial jobcal]"
	move a,jbcop		;If he already pclsr'd, give up, since he will
	tlne a,%jgcls		;give up on us since we did a JOBGET and saw
	 die			;that fact. 
	andi a,-1		;Separate out opcode
	caie a,%jornm		;Should be either FDELE
	 cain a,%jolnk		; or MLINK
	ifskp.
	  caie a,%joopn		; or OPEN
	   bug			;I wanna know if any new ops get defined.
	endif.
	setom jbcaln'		;Flag initial jobget done

	movei a,hstpag		;Try to figure out host
	movei b,chusr
	call netwrk"hstmap
	  bug
	move a,jbc+j.dev	;Get device
	movem a,jobdev'		;Save for reuse
	camn a,[sixbit/KANSAS/]	;Special dispensation
	 move a,[sixbit/OZKS/]
	camn a,[sixbit/SP/]	;Both acceptable, but standardize on one
	 move a,[sixbit/SPEECH/]
	movem a,jbc+j.dev
	tlz a,777700		;Mask out the first 2 chars
	came a,['DNRF]
	ifskp.
	  xorm a,jbc+j.dev	;Clear the DNRF part from official device name
	  tro f,f%dnrf		;and remember we had it
	endif.
	setzm fhostn
	move a,jbc+j.dev
	movem a,rdevn		;Remember device for .RCHST's
	movem a,fhost		;Assume it's the host name
	call sixhst
	 jrst [ hllz a,rdevn	;No luck, try first two chars
		tlz a,77
		movem a,fhost
		call sixhst
		 jrst [ movsi a,%ensdv	;No other good ideas, return with
			jrst nogoe]	;no such device
		move b,rdevn	;Won, get the foreign device
		lsh b,2*6	;from last 4 chars
		jrst .+2]
	 move b,[sixbit/PS/]	;Else default foreign device
	movem b,fdevn		;Remember this
	movem b,jbc+j.dev	;Here too, like MLDEV, not sure why
	movem a,fhostn		;Save host number
	call netwrk"hstunmap	;Flush host pages
	 bug
	move w,[440700,,buf]	;Cons RFC string
	move a,[sixbit/RMTDEV/]	;RMTDEV<sp>UNAME
	call wsix
	movei a,40
	idpb a,w
	.suset [.rxunam,,a]
	call wsix
	setz a,
	idpb a,w
conn:	note " Connect..."
	movei a,chneti		;Make the connection
	move b,fhostn		;Host number
	movei c,buf
	movei d,window
	call netwrk"chacon
	 jrst nogo
	txo f,f%conn		;Have a connection now
	setzm int		;All set up, can turn on interrupts now
	.suset [.smsk2,,[1_chboj+1_chneti+1_chneto]]
	setzm seqnum		;Start off transaction sequence numbers
	note "OK
"
;Joins here when reused.
REUSE1:	setom rplseq		;Not waiting for system call reply.
	setom accseq		;No access command outstanding.
	setzm iotcnt		;No iot in progress
	trz f,f%open\f%clss\f%pclsr ;No file open, no close or pcl outstanding
	tro f,fi%boj		;Fake a job interrupt for the initial jobcal.
	fallto goloop

;;Main program loop.
	;"<<"
goloop:	note "==>>Goloop"
	setzm int
	trze f,fi%nti		;Net input interrupt
	 jrst ntint		; Read and handle a packet from server
	skipe iotcnt		;If we interrupted an output IOT to read
	 tlnn f,%doout		;net replies
	  caia
	   jrst jioto		;Go back to finish it
	trze f,fi%boj		;BOJ interrupt
	 jrst bojint		; process user call
	trze f,fi%nto		;Net output interrupt
	 jrst ntoint		; Transfer some data if have any
	skipl int		;Nothing, wait for an interrupt
	 .hang
	jrst goloop

;;Here on chaosnet failure on initial command
nogo:	movsi a,%enadv	;Device not available.
nogoe:	movem a,errcod
	note "Connection failed"
	movei c,20.	;Number of times to JOBRET before we think other side
	do.		;is gone. 
	  .call jobcal
	    die		;JOBGET on initial is not supposed to fail.
	  move a,jbcop
	  tlne a,%jgcls	;He closed us so we can stop now.
	    exit.
	  .call jbrerr	;Keep trying to return this error, in case he pclsr's
	    sojg c,[movei b,1 ? .sleep b, ? jrst top.]	;and comes back.
	enddo.
	skipn fhostn	;Did we ever get a host?
	 die		;No, that's it
	fallto reuse	;Let him keep trying if he really wants to

;COME HERE WHEN WE HAVE BEEN FINISHED WITH BY ONE CREATOR, TO OFFER OURSELVES
;TO OTHERS.
REUSE:	MOVEI A,30.*5		;WAIT FIVE SECONDS FOR SOMEONE TO REUSE US.
	.SUSET [.SAMSK2,,[1_CHBOJ]]
	SYSCAL JOBREU,[
		JOBDEV		;DEVICE NAME WE ARE HANDLING.
		['JOBDEV]	;FILENAMES WE WERE LOADED FROM.
		JOBDEV
		['DEVICE]
		A]		;AMOUNT OF TIME TO WAIT
	 JRST REUSL
	.SUSET [.SIMSK2,,[1_CHBOJ]]
	note "AHere we go again..."
	SYSCAL RFNAME,[		;SOMEBODY GOBBLED US.  FIND OUT WHO, FOR PEEK.
		%CLIMM,,CHBOJ
		%CLOUT,,A
		%CLOUT,,CRUNAM
		%CLOUT,,CRJNAM]
	 JFCL
	jxe f,f%conn,conn
	movei a,r.reu
	call setcmd
	movem a,rplseq
	.suset [.rxunam,,a]
	call wsix
	call sndcmd
	do.
	  call reply
	  came b,rplseq
	   loop.
	enddo.
	note "Synched"
	jrst reuse1

;HERE IF WE SEE WE ARE NOT GOING TO BE REUSED.
REUSL:	TRNE F,F%CLSS	;IF WE SENT A CLOSE COMMAD, WE MUST WAIT FOR THE REPLY,
	 JRST GOLOOP	;WHICH WILL MAKE US COME BACK TO DIE.
;COME HERE TO REALLY GIVE UP THE GHOST.
$die:	txne f%dbug
;	 .break 16,100000
	 .value
	.logout 1,
	.value
	0

die==:<pushj p,$die>

	subttl BOJ interrupt dispatch

.scalar lastop		;Last opcode (unless f%pclsr)
.scalar ljbrta		;2 + .CALL JOBRET address if f%pclsr

pclsr:	note " Pclsr'd"
	pop p,ljbrta		;A failing jobret indicates that creator was
	setom lastop		;pclsrd and we should expect him to retry his
	tro f,f%pclsr\fi%boj	;system call. We must set FI%BOJ now because
	jrst goloop		;coming back in might not set the interrupt bit

pcl==:pushj p,pclsr		;Follow every JOBRET with this

bojint:	note "ABOJ interrupt..."
	setzm iotcnt		;I guess he gave up on that IOT...
	aosg jbcaln		;-1 if initial, don't do again
	ifskp.
	 .call jobcal
	   jrst goloop
	endif.
	move b,jbcop		;Dispatch on opcode
	tlne b,%jgcls
	 jrst jcls
	movei a,(b)
	caile a,%jocal
	  bug			;I want to know if any new ops get defined
	cain a,%jocal
	 move a,jbc+j.cal
	tlne b,%jgfpd		;If this is a retry of a call that pclsr'ed,
	 jrst [note "retry..."
	       skipl rplseq	;If waiting for a net reply to last command
		came a,lastop	;And really have the same opcode (paranoia...)
		 caia
		  jrst goloop	;Just keep waiting...
	        trzn f,f%pclsr	;Something PCLSR'd and we noticed?
	 	 jrst .+1	;No, treat this as a new invocation.
		note "retrying"
		move b,ljbrta	;Else yes, we finished with it so just give
		jrst -2(b)]	;him the same jobret again.
	setom rplseq	;I guess he no longer wants that reply
	setzm iotcnt	;or that (input) iot
	trz f,f%pclsr	;We can't handle a retry after anything else happens.
	movem a,lastop
	jrst @disp(b)

disp:	offset -.
%joopn:: jopen
%joiot:: jiot
%jolnk:: jmlink
%jorst:: jret			;Just return
%jorch:: jrch
%joacc:: jacc
%jornm:: jfdele
%jorwo:: jrnmwo
%jocal:: jsyscl
	offset 0

;More dispatching
jsyscl:	move a,jbc+j.cal	;Get .call name
	camn a,[sixbit/FORCE/]
	 jrst jforce
	camn a,[sixbit/FINISH/]
	 jrst jfinish
	camn a,[sixbit/FILLEN/]
	 jrst jfille
	camn a,[sixbit/SFDATE/]
	 jrst jsfdat
	camn a,[sixbit/SRDATE/]
	 jrst jsrdat
	camn a,[sixbit/SAUTH/]
	 jrst jsauth
	camn a,[sixbit/RFDATE/]
	 jrst jrfdat
	camn a,[sixbit/RRDATE/]
	 jrst jrrdat
	camn a,[sixbit/RAUTH/]
	 jrst jrauth
	camn a,[sixbit/ACCESS/]
	 jrst jsacc
	camn a,[sixbit/SREAPB/]
	 jrst jsreap
	note ".Call ?"
	nsix a
	note "?..."
	jrst wtderr		;That's all we handle.

	subttl Initial OPEN
;Should we check that file is not open already, or is that guaranteed?
jopen:	move a,jbc+j.mod	;Get open-mode
	trnn a,%doout
	 note "OpenI..."
	trne a,%doout
	 note "OpenO..."
	trne f,f%dnrf		;If DNRF: from device name
	 tro a,%donrf		;set here too
	movem a,opmode		;Save for JOBSTS
	hrl f,a			;And in F, for easy access
	movei a,%ensmd		;Check for unknown modes
	tlne f,#<%doout\%doimg\%doblk\%donrf\%donlk\%dorwt\%dowov>
	 jrst opnerr
	movei a,%esco		;Check for self-contradictory modes
	tlnn f,%doout
	 tlnn f,%dowov		;(RWT is also supposedly for output only, but
	  caia			;it sorta has a reasonable interpretation for
	   jrst opnerr		;input as well, so we'll just pass it on.)
	tlne f,%doblk		;Remember whether block ascii mode, it's
	 tlne f,%doimg		;special because server is in 7 bit (so we
	  trza f,f%blka		;can get exact eof) but user is really 36 bit.
	   tro f,f%blka
	trz f,f%dir
	move a,jbc+j.fnm	;Get the user-specified filename
	move b,jbc+j.snm
	move c,jbc+j.fn1
	move d,jbc+j.fn2
	move w,[440700,,trunam]	;Put it here temporarily
	call usrfnm
	call opnchk		;Check if have exactly two sixbit filenames
	ifskp.			;Look out for special names
	  came b,[sixbit/(DIR)/]
	   camn b,[sixbit/(UDIR)/]
	    came a,[sixbit/..NEW./]
	     caia
	      jrst jcrdir
	  camn b,[sixbit/(DIR)/]
	   came a,[sixbit/.EXPUN/]
	    caia
	     jrst jexpun
	  camn b,[sixbit/(DIR)/]
	   came a,[sixbit/.FILE./]
	    caia
	     jrst jdir
	endif.

jopnx:	move a,opmode		;Get just the basic mode
	andi a,%doblk\%doimg\%doout
	trc a,%doout		;flip direction (he reads<=>we write, and v.v.)
	tro a,30		;unhang our iots if he pclsrs.
	syscal open,[%climm,,chboj ? %clbtw,,a ? [sixbit/BOJ/]]
	 die

;Initialize some variables
	movei a,35.		;Number of bits in each buffer word
	tlne f,%doimg
	 movei a,36.
	movem a,wdlen
	subi a,32.		;Difference from packet word length
	movem a,fudge
	movei a,7		;Byte size of connection to user.
	tlnn f,%doblk
	 tlne f,%doimg
	  movei a,36.
	movem a,bytsiz
	movei b,bufl		;Size of buffer in those bytes
	cain a,7
	 imuli b,5
	movem b,bufsiz
	call bufini		;Buffer and allocation pointers/counts
	setzm raccp		;File position
	trz f,f%eofi		;Haven't seen an eof yet

	movei a,r.opno		;Send command to server
	tlnn f,%doout
	 movei a,r.opni
	txne f,f%dir
	 movei a,r.dirl
	note "setcmd..."
	call setcmd
	movem a,rplseq		;Save sequence # for error checking
	ifxe. f,f%dir
	  movei a,7.		;Open byte size (tell him 7 even if block ascii
	  tlne f,%doimg		;so we can do our local style of eof padding)
	   movei a,36.
	  nout a
	  call wdec
	  movei a,chnl
	  idpb a,w
	  note " "
	  movei a,[asciz "/NRF"]	;Next come the options
	  tlne f,%donrf
	   note "/NRF"
	  tlne f,%donrf
	   call wstr
	  movei a,[asciz "/NLK"]
	  tlne f,%donlk
	   note "/NLK"
	  tlne f,%donlk
	   call wstr
	  movei a,[asciz "/RWT"]
	  tlne f,%dorwt
	   note "/RWT"
	  tlne f,%dorwt
	   call wstr
	  movei a,[asciz "/WOV"]
	  tlne f,%dowov
	   note "/WOV"
	  tlne f,%dowov
	   call wstr
	  movei a,chnl
	  idpb a,w
	endif.
	note " "
	move a,alccnt		;Next the initial allocation
	call wdec
	nout alccnt
	movei a,chnl
	idpb a,w
	note " "
	movei a,trunam		;And finally the filename
	call wstr
	nstr trunam
	call sndcmd

	note "A  reply..."
	call reply		;Get the reply
	came b,rplseq
	 bug
	setom rplseq
	jumpn a,opnerr
	note "OK"
	call rsts		;Open reply is like status
	.call jbrwin		;Tell the creator that the open succeeded.
	 call ipclsr
	tro f,f%open		;He now has the file open
	jrst goloop

opnerr:	note "Bad#"
	nout a
	hrlzm a,errcod		;Here for failure reply to initial command
	.call jbrerr		;Return the error
	  call ipclsr		;Different pclsr handling for initial commands
	jrst reuse		;And we're all finished.

ipclsr:	movei a,30.	;if initial jobret fails, wait a while before jobgeting
	.sleep a,	;since if we jobget before he retries we will read a
	jrst pclsr	;close and give up, and he will do whatever it is twice

bufini:	movei a,buf
	movem a,netptr
	movei b,440700
	tlne f,%doimg
	 hrli b,444400
	tlnn f,%doblk
	 hrl a,b
	movem a,bufptr
	move a,bufsiz
	movem a,bufptn
	tlnn f,%doout
	 setz a,
	movem a,bufcnt
	movei a,buf+bufl-1
	movem a,alcptr
	movei a,bufl-1
	imul a,wdlen
	tlne f,%doout
	 setz a,
	movem a,alccnt
	ret

	subttl Other first-call cases

;Handle OPEN of .FILE. (DIR) -- List a directory
jdir:	note "DirLst..."
	tlne f,%doout\%doimg\%donrf\%donlk\%dorwt
	  jrst wtderr
	tro f,f%dir
	move b,trufnb		;Get the filename frob from opnchk
	add b,[4,,0]		;Flush filenames
	move d,[440700,,temfn1]
	call rfnl"pfn
	move a,[temfn1,,trunam]
	blt a,trunam+fnmstl-1
	jrst jopnx		;Join open code

;Handle OPEN of .EXPUN (DIR) -- Expunge a directory.
jexpun:	note "Expunge..."
	jrst wtderr		;Not implemented yet

;Handle OPEN of .NEW.. (UDIR) -- Create a directory.
jcrdir:	note "CrDir..."
	jrst wtderr		;Not implemented yet

;Handle MLINK -- Create a link.
jmlink:	note "MLink..."
	jrst wtderr		;Not implemented yet

;Handle .FDELE -- Delete or rename a file
jfdele:	move a,jbc+j.fnm	;Get the user-specified filename
	move b,jbc+j.snm
	move c,jbc+j.fn1
	move d,jbc+j.fn2
	move w,[440700,,trunam]	;Put it here temporarily
	call usrfnm
	skipn jbc+j.tfn1	;Have a target?
	ifskp.
	  note "Rename "	;Then it's a rename
	  movei a,r.renm
	  call setcmd
	  movem a,rplseq
	  movei a,trunam
	  nstr trunam
	  call wstr
	  movei a,chnl
	  idpb a,w
	  note " to "
	  move a,jbc+j.tfnm	;Get target filename
	  move b,jbc+j.snm
	  move c,jbc+j.tfn1
	  move d,jbc+j.tfn2
	  push p,w		;Read it into a buffer for logging
	  move w,[440700,,buf]
	  call usrtfn
	  pop p,w
	  movei a,buf
	  nstr buf
	  call wstr
	else.
	  note "Delete "
	  movei a,r.dele
	  call setcmd
	  movem a,rplseq
	  movei a,trunam
	  nstr trunam
	  call wstr
	endif.
	call sndcmd
	call reply		;Get the reply
	came b,rplseq
	 bug
	setom rplseq
	jumpn a,opnerr
	.call jbrwin
	 call ipclsr
	jrst reuse

	subttl Assorted non-initial non-i/o commands

;Note that the documentation claims only raccp word is used here... The system
;uses filenames from last jobsts.
jrch:	note "RCHST..."
	syscal jobret,[%climm,,chboj ? %climm,,0 ? [-5,,raccp-4]]
	 jrst bojint	;No need for "PCL" since we haven't altered anything.
	jrst goloop

jfinish:note "Finish..."	;.CALL FINISH
	;;Maybe should also wait for output access to be ack'd.
jforce:	note "Force..."
	call force		;.CALL FORCE
	jrst jrwin

jfille:	note "Fillen..."
	skipge fillen		;.CALL FILLEN
	 jrst wtderr		;Not defined
	move a,[-4,,fillen]
	jrst jrval

;Foo, it looks like we're not expected to return anything to the creator.
;If file fails to get created properly, he'll never know.  I wonder, does
;the .close return immediately or only when we issue the jobreu?  If latter,
;maybe we should hold off on that so we can at least signal ioc errors...
jcls:	note "Close..."
	tlne f,%doout
	 call force	;Force out buffered output.  Maybe should also wait
			;for all access's to get ack'd?
	movei a,r.cls	;Set up a close packet
	call setcmd
	movem a,rplseq
	call sndcmd	;No args, just send it
	tlne f,%doout
	 tro f,f%clss	;Stick around until we receive a reply or else server
	jrst reuse	;might notice we're gone and abort

;Close continuation.  We only get here if it turned out we weren't reused,
;since we don't do net interrupts while waiting for a reuse.
xcls:	note "Close..."
	die

jsacc:	move a,jbc+j.arg2	;Access pointer for symbolic call ACCESS
	movem a,jbc+j.ptr
	call jacc1		;Common .call/uuo routine
jrwin:	note "<retskp>"
	.call jbrwin		;Just skip-return...
	 pcl
	jrst goloop

jacc:	call jacc1
jret:	note "<ret>"
	.call jbret		;Just return...
	 pcl
	jrst goloop

jacc1:	note "Access "
	nout raccp		;"<"
	note "=>"
	nout jbc+j.ptr
	note  "..."
	move b,jbc+j.ptr
	camn b,raccp
	 ret
	tlne f,%doout		;If doing input
	ifskp.			;see if can do it locally
	  sub b,raccp
	  cail b,0
	   camle b,bufcnt
	anskp.			;No such luck
	  note "(local)"
	  addm b,raccp		;Else update the file pointer
	  movn a,b		;And buffer count
	  addm a,bufcnt
	  tlnn f,%doblk		;Update buffer pointers
	   tlne f,%doimg
	    tdza c,c
	     idivi b,5
	  add b,bufptr
	  sojge c,[ibp b ? jrst .]
	  add a,bufptn
	  ifle. a		;Gone past end of buffer?
	    add a,bufsiz	;Yea, wrap
	    subi b,bufl
	  endif.
	  movem a,bufptn
	  movem b,bufptr	;B/updated bufptr for sndalc
	  callret sndalc	;Send allocation if need to and that's it!
	endif.

	tlne f,%doout		;Do it for real
	 call force		;If output, force it out now.
	call bufini		;Flush old input
	trz f,f%eofi		;No longer have an eof
	movei a,r.acc
	call setcmd
	movem a,accseq
	move a,jbc+j.ptr
	movem a,raccp
	trne f,f%blka		;In block ascii mode, server is in 7-bit
	 imuli a,5		;bytes even though the user is in 36 bit.
	call wdec
	movei a,chnl
	idpb a,w
	move a,alccnt		;Include new allocation
	call wdec
	callret sndcmd		;send the command.

xacc:	note "Access..."
	skipge accseq
	  bug
	camn b,accseq		;Is this the one we're waiting for?
	 setom accseq		;Yup, so no longer any outstanding
	tlnn f,%doout
	 skipge accseq
	  skipn a
	   jrst goloop		;No error, or just an old input reply, ignore
	note "Bad#"
	nout a
	;Here if error and either the latest input or ANY output reply
	syscal jobioc,[%climm,,chboj ? %climm,,2] ;Make a reasonable error
	 .lose
	;If this is input, could recover because no I/O can take place
	;until all .ACCESS's ack'd, figure it out later. (Basically:
	;give ioc errors on all iot's until he gives a working .access,
	;remember to give ioc error now if iotcnt non-zero.  Need to remember
	;that that alloc didn't take either thou)
	;For output, maybe should wait for reply before returning to user
	;so we don't have to deal with outstanding access's.  All sorts
	;of synch problems with closing the file and such... Better yet,
	;output iots should hang if there are outstanding access's too.
	die

jsreap:	note "SReapb "
	movei a,r.srpb		;Set the do-not-reap bit
	call setcmd
	movem a,rplseq
	move a,jbc+j.arg2
	call wdec
	nout a
	call sndcmd
	jrst goloop

xsreap:	note "XSReapb "
	jrst xret

jrnmwo:	skipn jbc+j.tfn1
	 jrst jdelwo
	note "Rnmwo..."
	movei a,r.rnmwo
	call setcmd
	movem a,rplseq
	move a,jbc+j.tfnm
	setz b,			;No target sname!
	move c,jbc+j.tfn1
	move d,jbc+j.tfn2
	call usrtfn
	call sndcmd
	jrst goloop

xrnmwo:	note "Rnmwo..."
	ife. a			;If no error, server DID change the names so...
	  push p,b		;read the new names even if user gave up.
	  call rfname
	  pop p,b
	  setz a,
	endif.
	jrst xret

jdelwo:	note "Delwo..."
	movei a,r.delwo
	call setcmd
	movem a,rplseq
	call sndcmd
	jrst goloop

xdelwo:	note "Delwo..."
xret:	came b,rplseq		;Were we still waiting for this?
	 jrst goloop		;No, tough
	setom rplseq		;Else no longer wait for it
	jumpn a,jrerr		;If error, tell him so
	jrst jrwin		;Else report success.

jsrdat:	note "SRDate..."
	movei t,filref
	movei a,r.srd
	jrst jsdate
jsfdat:	note "SFDate..."
	movei t,fildat
	movei a,r.sfd
jsdate:	call setcmd
	movem a,rplseq
	move a,jbc+j.arg2
	call datime"timnet
	movem a,rplval'		;Remember the new date
 	setzm (t)		;No longer know the real date
	call wdec
	call sndcmd
	jrst goloop

jsauth:	note "SAuthor..."
	movei a,r.saut
	call setcmd
	movem a,rplseq
	move a,jbc+j.arg2
	movem a,rplval		;Remember the new author
	setzm filaut		;No longer know the real author
	call wsix
	call sndcmd
	jrst goloop

xsrdat:	note "SRDate..."
	movei t,filref
	jrst xsval
xsfdat:	note "SFDate..."
	movei t,fildat
	jrst xsval
xsauth:	note "SAuthor..."
	movei t,filaut
xsval:	came b,rplseq
	 jrst goloop
	setom rplseq
	jumpn a,jrerr
	move a,rplval		;Server won, install the new value
	movem a,(t)
	jrst jrwin		;And tell the user

jrrdat:	note "RRDate..."
	hrroi a,filref		;.CALL RRDATE
	jrst jrdata
jrfdat:	note "RFDate..."
	hrroi a,fildat		;.CALL RFDATE
	jrst jrdata
jrauth:	note "RAuthor..."
	hrroi a,filaut		;.CALL RAUTH
jrdata:	skipe (a)		;Have it locally?
	 jrst rdata		;Yes, just return it
	movem a,rplval		;Else read status from server
	movei a,r.rsts
	call setcmd
	movem a,rplseq
	call sndcmd
	jrst goloop

xrsts:	note "RStatus..."
	ife. a			;If successful reply
	  push p,b		;Might as well read it in
	  call rsts
	  pop p,b
	  setz a,
	endif.
	came b,rplseq		;Were we waiting for this?
	 jrst goloop		;No, he gave up
	setom rplseq
	jumpn a,jrerr
	move a,rplval		;Do we have the value we want now?
	skipn (a)
	 jrst wtderr		;No, must be unknowable

rdata:	camn a,[-1,,filaut]	;Else return it.
	 jrst jrval		;Author is simple
	move a,(a)		;Dates have to be converted first tho
	subi a,datime"estdif*60.*60.
	call datime"sectim
	movei b,3600.
	call datime"odayl
	 call datime"timadd
	movem a,dskdat'
	hrroi a,dskdat
jrval:	movem a,retval'		;All args must stay around in case pclr'd
	note "<retval>"
	.call jbrval
	 pcl
	jrst goloop

rsts:	note "len "
	call rwdec		;Length in open bytes
	 seto a,		;Not specified
	nout fillen
	ifxn. f,f%blka		;If block ascii, he is open in 7 but we're 36
	andge. a
	  addi a,4
	  idiv a,5
	endif.
	movem a,fillen
	note " bsz "
	call rwdec		;Byte size of last open
	 setz a,
	movem a,filbsz
	nout filbsz
	note " bln "
	call rwdec		;Size in bytes of last open
	 setz a,
	movem a,filbln
	nout filbln
	tlnn f,%doout
	ifskp.
	  move a,bytsiz
	  movem a,filbsz
	  move a,fillen
	  movem a,filbln
	endif.
	note " cre "
	call rwdec		;Creation date
	 setz a,
	movem a,fildat
	nout fildat
	note " ref "
	call rwdec		;Reference date
	 setz a,
	movem a,filref
	nout filref
	note " aut "
	call rwsix		;Author
	movem a,filaut
	nsix filaut
rfname:	note " fnm "
	movei a,trunam		;True name
	call rwstr
	nstr trunam
	note "."
	call unparse		;Unparse truename into RDEVN block
	move a,[trunam,,sysnam]
	blt a,sysnam+fnmstl-1
	.call jobsts		;Give it to system for RCHST/RFNAME.
	  bug
	ret

wtderr:	note "WTDErr"
	movei a,%ebddv		;Return "Wrong type device"
	jrst jrerrX
jrerr:	note "<Err#"
	nout a
	note ">"
jrerrX:	hrlzm a,errcod'
	.call jbrerr
	 pcl
	jrst goloop

	subttl IOT/SIOT

jiot:	note "JIOT("
	trnn f,f%open
	  bug
	tlnn f,%doblk		;Figure out length of transfer
	ifskp.			;Block mode
	  hlre a,jbc+j.ptr
	  movns a
	else.			;Else unit mode
	  move a,jbcop
	  tlne a,%jgsio
	   skipa a,jbc+j.cnt
	    movei a,1
	endif.
	movem a,iotcnt		;Save new number of bytes not sent yet
	nout iotcnt
	note ")..."
	tlnn f,%doout		;Dispatch on direction
	 jrst jioti
	fallto jioto

;Maybe should hang if there are access's outstanding...
jioto:	skipe d,iotcnt		;If nothing more to do
	 trne f,fi%nti		;or there are replies waiting
	  jrst goloop		;Bail out
	skipe c,bufcnt		;Get # bytes available in our buffer.
	ifskp.			;None, send a data packet to make room,
	  call snddat		;even if it means hanging
	   bug
	  jrst jioto		;Should work ok now, but check for FI%NTI again
	endif.
	call bojiot		;Do it.  A gets new raccp
	skipl fillen		;If file length known&settable
	 camg a,fillen		;and writing past end of file
	ifskp.
	  movem a,fillen	;then update the file length
	  movem a,filbln
	endif.
	call jout		;Send off some data if we can
	jrst jioto		;Try it again

;Come here for network output interrupt to move data from buffer to net.
ntoint:	note "ANET Output interrupt..."
	trne f,f%open
	 tlnn f,%doout
	  jrst goloop
	move a,bufcnt		;Anything in buffer?
	camge a,bufsiz
	 call jout		;Yea, output whatever we can to the network.
	note "done"
	jrst goloop

;Output data from BUF to the server, as much as we can without hanging.
;Clobbers A-E,T,TT,J
jout:	syscal whyint,[%climm,,chneto ? %clout,,j ? %clout,,j ? %clout,,j]
	  .lose %lsfil
	tlz j,-1		;Number of packets we can send
	jumpe j,cpopj		;No room for any data
	call snddat		;Send some
	 ret			;No more, done
 	sojg j,.-2		;Not finished yet, go again.
	txo f,fi%nto		;Out of room, come back later to check again
	ret

force:	call snddat		;Send some
	 ret			;No more
	jrst force

;Send a data packet to server.  Clobbers A-E,T,TT.
;Skips if there was data to send.
snddat:	move e,bufsiz		;Figure number of bytes used
	sub e,bufcnt
	jumpe e,cpopj		;None, finished
	move c,bytsiz
	trne f,f%blka		;Convert to (server) bit count
	 move c,wdlen
	imul e,c
	hlrz d,netptr		;D=bits already sent from first word
	move a,d
	idiv a,bytsiz
	sub e,b			;E=# bits we can send
	caile e,8*%cpmxc	;At most a packet's worth
	 movei e,8*%cpmxc	;E=# bits we're going to send
	add b,e			;Update byte count
	idivi b,(c)
	addm b,bufcnt
	hrrz c,netptr		;C=input address
	move a,d		;Compute new bufptr
	add a,e
	idiv a,wdlen
	hrlm b,netptr
	hrrz b,netptr
	add a,b
	cail a,buf+bufl
	 subi a,bufl
	hrrm a,netptr
	movei a,7(e)		;Compute packet counts
	idivi a,8
	dpb a,[$cpknb+pktbuf]	;Number of bytes
	trc b,%codat\7		;Account for the padding bits
	dpb b,[$cpkop+pktbuf]
	addi a,3		;Compute output words
	idivi a,4
	movns a
	hrl b,a
	hrri b,%cpkdt+pktbuf	;B=output aobjn pointer
	move t,(c)		;Reprocess 1st word
	aoj c,
	tlne f,%doimg		;Right justify it for loop
	ifskp.			;If ascii
	  lsh t,-1
	  aoj d,		;One more available bit
	endif.
	do.
	  cain c,bufend
	   movei c,buf
	  move tt,(c)
	  lshc t,(d)
	  movem t,(b)
	  aobjp b,endlp.
	  sub d,fudge		;WdLen-32
	  ifl. d
	    lshc t,40
	    movem t,(b)
	    aobjp b,endlp.
	    addi d,40
	  endif.
	  movn e,d
	  lshc t,40(e)
	  aoja c,top.
	enddo.
	.call pktout		;Send the packet
	  .lose
	jrst cpopj1

jioti:	skipg d,iotcnt
	 jrst goloop
	note "AJiotI "
	nout iotcnt
	note "/"
	nout bufcnt
	note "..."
	skipe c,bufcnt		;How many bytes do we have available
	ifskp.			;None
	  trnn f,f%eofi		;Server sez end of file?
	   jrst goloop		;No, go wait for more
	  note "<Send Eof>"
	  move a,jbcop		;Else tell user about eof
	  tlnn a,%jgsio		;If SIOT
	   tlne f,%doblk	;Or block mode
	    jrst jret		;Just wake him up
	  tlnn f,%doimg		;Else unit mode IOT
	   jrst [.iot chboj,[-1,,^C]	;If ascii, indicate EOF
		 jrst goloop]
	  syscal jobioc,[%climm,,chboj ? %climm,,2]  ;Else IOCERR for EOF
	   jrst bojint
	  jrst goloop
	endif.
	call bojiot		;Do it, B gets new bufptr
	skipn iotcnt
	ifskp.
	  nout iotcnt
	  note " left to send."
	else.
	  note "All."
	endif.
	call sndalc		;Send allocation if appropriate
	jrst jioti		;Go try again

;Send allocation if necessary.  Call with B/bufptr
sndalc:	tlnn f,%doblk		;Get address of first used word
	 ibp b
	tlz b,-1
	move a,b		;See how many words we could allocate
	sub a,alcptr
	sosge a			;Always leave one for image mode overflow
	 addi a,bufl
	note "{alccnt:"
	nout alccnt
	note " Room:"
	nout a
	note "}"
	caige a,bufl/2		;At least half the buffer?
	 ret			;No, don't bother
	note "ASending Allocation "
	sos b			;Save new pointer
	caige b,buf
	 addi b,bufl
	movem b,alcptr
	imul a,wdlen
	nout a
	addm a,alccnt		;and count
	push p,a		;Now send the command
	movei a,r.alc
	call setcmd
	pop p,a
	call wdec
	callret sndcmd

;XDAT - read data from net
;Enters with opcode in B.
xdat:	note "Data..."
	skipl accseq		;Waiting for access ack's?
	 jrst goloop		;Yea, keep waiting
	trne f,f%eofi
	 bug
	ldb a,[$cpknb+pktbuf]
	jumpe a,goloop
	imuli a,8		;Number of bits in packet
	trz b,%colst		;Subtract padding
	sub a,b			;A=# data bits in packet
	nout a
	note "bits"
	movn b,a		;Update alccnt
	addm b,alccnt
	note "(alccnt="
	nout alccnt
	note ")..."
	skipge alccnt
	 bug
	hlrz b,netptr		;Update byte count
	idiv b,bytsiz
	add c,a
	move b,bytsiz
	txne f,f%blka
	 move b,wdlen
	idiv c,b
	addm c,bufcnt
	hlrz d,netptr		;D=bit count in last word
	add a,d			;Update the bit count
	idiv a,wdlen
	hrlm b,netptr
	hrrz b,netptr
	movni a,1(a)
	hrl b,a			;B= output aobjn pointer
	movei c,%cpkdt+pktbuf	;C= input address
	movei a,buf+bufl	;A= bufend, for easy wraparound checking
	move t,(b)		;Re-do the last word
	do.
	  lsh t,-36.(d)
	  sub d,fudge
	  ifl. d
	    move tt,(c)
	    aoj c,
	    lshc t,32.
	    addi d,32.
	  endif.
	  move tt,(c)
	  aoj c,
	  movni e,4(d)
	  rotc t,(e)
	  tlnn f,%doimg
	   lsh tt,1
	  cain a,(b)
	   hrri b,buf
	  movem tt,(b)
	  aobjn b,top.
	enddo.
	soj b,
	hrrm b,netptr
	ldb b,[$cpkop+pktbuf]	;Is this an eof packet?
	caige b,%colst
	 jrst jioti		;No, just go see if user wants this data
	tro f,f%eofi		;Hit end of file
	note "<EOF>"
	trnn f,f%blka		;If block ascii mode then might need to pad
	 jrst jioti		;beyond the ascii eof for the user
	hlrz a,netptr
	idivi a,7
	jumpe a,jioti		;If didn't end on word boundary
	move b,netptr		;Skip over complete bytes we've received
	hrli b,440700
	ibp b
	sojg a,.-1
	movei c,^C		;And fill the rest with ^C's
	idpb c,b
	tlne b,700000
	 jrst .-2
	aos bufcnt		;Count this last word
	jrst jioti

;;BOJIOT: perform an IOT/SIOT on the BOJ channel.
;;Called with C/# bytes available
;;	      D/# bytes requested
;;Updates bufptr/bufptn,bufcnt,iotcnt and raccp.
;; Returns with A/new raccp
;;		B/new bufptr
bojiot:	camle c,bufptn		;Only go to end of buffer, since IOT/SIOT will
	 move c,bufptn		;not wrap for us
	camle c,d		;Don't take more than he has
	 move c,d		;C= # bytes we will read
	sub d,c			;# bytes of user's IOT that will be left.
	movem d,iotcnt
	move b,bufptr
	tlne f,%doblk
	ifskp.			;Unit mode
	  move a,c
	  syscal siot,[%climm,,chboj ? b ? c]
	   .Lose
	  sub a,c		;A=# bytes we got, C=# bytes we didn't get
	else.			;Else block mode
	  movn a,c		;Make AOBJN ptr to the words we can read.
	  hrl b,a
	  .iot chboj,b
	  hrrzs a,b
	  sub a,bufptr		;A=# words we got
	  sub c,a		;C=# words we didn't get
	endif.
	skipe c			;If didn't get everything, pclsr'd, so don't
	 setz d,		;try to get any more.
	movn c,a		;Decrement counts
	addm c,bufcnt		;This many fewer bytes available
	addm c,bufptn		;And fewer til end of BUF
	skipe bufptn		;Reached end of BUF?
	ifskp.
	  subi b,bufl		;Yes, wrap
	  move c,bufsiz
	  movem c,bufptn
	endif.
	movem b,bufptr
	addb a,raccp
	ret

;Here from GOLOOP to process input from net.
ntint:	note "ANet Input interrupt..."
	syscal whyint,[%climm,,chneti ? %clout,,a ? %clout,,b ? %clout,,c]
	 .Lose %lssys
	cain a,%wycha
	 caie b,%csopn
	  jrst [note "AConn state="
		nout b
		note " A="
		nout a
		jrst ntioc]
	tlnn c,-1
	 jrst goloop		;No more input, done
	txo f,fi%nti		;Else come back here when done
	note "read..."
	.call pktin
	 .lose %lsfil
	ldb b,[$cpkop+pktbuf]
	cail b,%codat
	 caile b,%codat+17
	  caia
	   jrst xdat
 	cain b,%coasy
	 jrst xioc
	note "reply..."
	call rreply
	move c,b
	andi c,377
	cain c,r.cls
	 jrst xcls
	cain c,r.acc
	 jrst xacc
	cain c,r.rnmwo
	 jrst xrnmwo
	cain c,r.delwo
	 jrst xdelwo
	cain c,r.rsts
	 jrst xrsts
	cain c,r.sfd
	 jrst xsfdat
	cain c,r.srd
	 jrst xsrdat
	cain c,r.saut
	 jrst xsauth
	note "Unknown!"
	bug

;Read a reply packet. B gets sequence#+opcode, A gets error
;code, V/W set up for reading data
reply:	.call pktin
	  .lose
	ldb b,[$cpkop+pktbuf]
rreply:	caie b,%colos
	 cain b,%cocls
	  jrst [note "ALoss or Close pkt received"
		jrst ntioc]
	cain b,%coeof
	 jrst [note "AEOF pkt received"
	       jrst ntioc]
	caie b,%corpl
	 bug
	ldb v,[$cpknb+pktbuf]
	subi v,4
	skipge v
	 bug
	ldb b,[143000,,%cpkdt+pktbuf]
	move w,[041000,,%cpkdt+pktbuf]
	ldb a,w
	ret

;Server reports asynchronous lossage.
xioc:	ldb a,[341000,,%cpkdt+pktbuf]
	note "server IOC error #"
	nout a
	syscal jobioc,[%climm,,chboj ? a]	;report it to the creator.
	 jfcl
	die

;Give the user an IOC error because the connection is closed.
;The server is most likely to use 3=non-recoverable data error for his
;errors, so we pick something else..
ntioc:	note "ALocal net error!"
	syscal jobioc,[%climm,,chboj ? %climm,,1] ;Illegal hardware operation
	 jfcl
	die

	subttl subroutines to read/write command packets
;Start creating a command packet in PKTBUF. A has opcode.
;On return, W is a BP to store the rest, A is the transaction code
setcmd:	move w,[141000,,%cpkdt+pktbuf]
	dpb a,w
	aos a,seqnum
	dpb a,[242000,,%cpkdt+pktbuf]	;Sequence
	ldb a,[143000,,%cpkdt+pktbuf]	;Return whole seq+opcode id
	ret

wsix:	setz b,
	rotc a,6
	addi b,40
	idpb b,w
	jumpn a,wsix
	ret

wdec:	idivi a,10.
	ifn. a
	  push p,b
	  call wdec
	  pop p,b
	endif.
	addi b,"0
	idpb b,w
	ret

wstr:	hrli a,440700
	do.
	  ildb b,a
	  jumpe b,cpopj
	  idpb b,w
	  loop.
	enddo.

;Send the packet in PKTBUF, assuming that W contains a bp
;down which the text of the packet has been stuffed.
sndcmd:	movei b,1-pktbuf-%cpkdt(w)	;Compute length of packet
	imuli b,4
	lsh w,-41
	sub b,w
	movei a,%comnd
	dpb a,[$cpkop+pktbuf]
	dpb b,[$cpknb+pktbuf]
	.call pktout
	 .lose %lsfil
	ret

rwdec:	sojl v,cpopj
	ildb b,w
	cain b,chnl
	 ret
	aos (p)			;Have a number, so skip return
	setz a,
	do.
	  cail b,"0
	   caile b,"9
	    bug
	  imuli a,10.
	  addi a,-"0(b)
	  sojl v,cpopj
	  ildb b,w
	  cain b,chnl
	    ret
	  loop.
	enddo.

rwstr:	hrli a,440700
	do.
	  sojl v,endlp.
	  ildb b,w
	  cain b,chnl
	   exit.
	  idpb b,a
	  loop.
	enddo.
	setz b,
	idpb b,a
	ret

rwsix:	setz a,
	move b,[440600,,a]
	do.
	  sojl v,cpopj
	  ildb c,w
	  cain c,chnl
	   ret
	  cail c,140
	   subi c,40
	  subi c,40
	  tlne b,770000
	   idpb c,b
	  loop.
	enddo.


	subttl filename parsing

fnblen==30.			;At most 30. components

	.scalar temfn1(fnmstl),fnb1(2*fnblen)	;Initial user string
	.scalar temfn2(3),fnb2(2*fnblen)	;Default dir
	.scalar fnb(2*fnblen)			;Merged block
	.scalar trufnb		;trunam pointer after opnchk

;;Check if trunam filename (not counting device/dir) can be expressed exactly
;;as 2 sixbit words, which are returned in a,b.
opnchk:	move b,[-2*fnblen,,fnb]
	move d,[440700,,trunam]
	call rfnl"rfn
	 ret
	movem b,trufnb
	do.			;Skip to filenames proper
	  jumpge b,cpopj
	  ldb a,1(b)
	  caie a,":
	   cain a,";
	    caia
	     exit.
	  add b,[2,,2]
	  loop.
	enddo.
	hlrz a,b
	caie a,-4		;Must be exactly two filenames
	 ret
	call namsix
	 ret
	push p,a
	add b,[2,,2]
	call namsix
	 ret
	move b,a
	pop p,a
	jrst cpopj1

;;Convert trunam to ITS format in RDEVN
unpars:	move b,[-2*fnblen,,fnb]
	move d,[440700,,trunam]
	call rfnl"rfn
	 nop
	setzm rdevn+1
	setzm rdevn+2
	setzm rdevn+3
	do.			;Skip device
	  jumpge b,cpopj
	  ldb a,1(b)
	  caie a,":
	   exit.
	  add b,[2,,2]
	  loop.
	enddo.
	caie a,";		;Process directory
	ifskp.
	  call namsix
	   move a,[sixbit/.CANT./]
	  movem a,rdevn+3
	  do.
	    add b,[2,,2]
	    jumpge b,cpopj
	    ldb a,1(b)		;Is the next one also a directory?
	    caie a,";
	     exit.
	    move a,[sixbit/.CANT./]	;Yea, we lose
	    movem a,rdevn+3
	    loop.
	  enddo.
	endif.
	call namsix
	 nop
	movem a,rdevn+1
	add b,[2,,2]
	jumpge b,cpopj
	call namsix
	 nop
	movem a,rdevn+2
	note "("
	nsix rdevn
	note ":"
	nsix rdevn+3
	note ";"
	nsix rdevn+1
	note " "
	nsix rdevn+2
	note ")"
	ret

;;Given name in (b)-1(b), return its sixbit rep in a.
;;Skips if rep is exact.
namsix:	setz a,
	hrrzs (p)
	move e,[440600,,a]
	move d,(b)
	do.
	  ildb c,d
	  camn d,1(b)
	   exit.
	  tlnn e,770000
	   ret			;longer than 6 chars
	  caie c,^Q
	  ifskp.
	    camn d,1(b)
	     ret		;Could happen if had ^Q^@
	    ildb c,d
	    cail a,140		;Quoted lower case can't be represented..
	     hrros (p)
	  endif.
	  caige c,40
	   hrros (p)
	  caige c,140
	  ifskp.
	    cail c,"a
	     caile c,"z
	      hrros (p)		;Non-letter "uppercase" chars can't go...
	    subi c,40
	  endif.
	  subi c,40
	  idpb c,e
	  loop.
	enddo.
	skipl (p)
cpopj1:	 aos (p)
cpopj:	ret

;Get user filename into pointer in W.  Called with A=pointer,B/C/D=snm/fn1/fn2
usrfnm:	call getusr		;get it into temfn1/fnb1
	push p,b		;Save block
	move d,[440700,,temfn2]	;Make default name, just "SNAME;"
	movem d,fnb2
	.uset chboj,[.rsname,,a]
	movei b,";
	call sixnam
	movem d,fnb2+1
	pop p,a			;Get user's spec
	move b,[-2,,fnb2]	;and the default
	jrst usrmrg

;Get user name, defaulting sname from TRUNAM, for RENMWO... Really should
;default it from the specified name, in case there are links... Don't
;worry about it for now, there are no servers on hosts with links.
;When do fix it, remember to updated the 'specified' name when renmwo is done!
usrtfn:	call getusr
	push p,b
	move b,[-2*fnblen,,fnb2]
	move d,[440700,,trunam]
	call rfnl"rfn
	 nop
	do.
	  jumpge b,endlp.
	  ldb a,1(b)
	  caie a,":
	   cain a,";
	    caia
	     exit.
	  add b,[2,,2]
	  loop.
	enddo.
	movni c,-fnb2(b)
	hrl b,c
	hrri b,fnb2
        pop p,a
usrmrg:	move c,[-2*fnblen,,fnb]	;Merged block here
	setz d,			;Normal defaulting
	call rfnl"merge		;Merge
	 nop
	move b,c		;B=fnm block
	move d,w		;D=output bp
	add b,[2,,2]		;Punt the first device (XX: or whatever)
	skipl b			;Check next
	 tdza a,a
	  ldb a,1(b)
	cain a,":		;Another device?
	ifskp.
	  push p,b
	  move a,fdevn		;No, use the default one
	  movei b,":
	  call sixnam
	  pop p,b
	  movei a,.chspc	;Add a space if there is something else there
	  skipge b		;(just for compatibility with rnfl"pfn)
	   idpb a,d
	endif.
	call rfnl"pfn		;Append name
	move w,d		;Update pointer
	setz a,
	idpb a,d
	ret

getusr:	ife. a			;If no user pointer
	  push p,d		;Just make a string from the sixbit names
	  push p,c
	  push p,b
	  move d,[440700,,temfn1]
	  move a,rdevn
	  movei b,":
	  call sixnam
	  pop p,a
	  movei b,";
	  call sixnam
	  pop p,a
	  movei b,.chspc
	  call sixnam
	  pop p,a
	  movei b,0
	  call sixnam
	  move d,[440700,,temfn1]
	else.
	  .uset chboj,[.ruindex,,b]	;Fetch user string
	  syscal open,[%clbit,,.bai ? %climm,,chusr
		       [sixbit/usr/] ? %climm,,%jsnum(b) ? %climm,,0]
	   die
	  hrrz b,a
	  .access chusr,b
	  move b,[-fnmstl,,temfn1]
	  .iot chusr,b
	  .close chusr,
	  move d,a
	  hrri d,temfn1
	;This is wrong in the aobjn pointer case, I had misunderstood.
	;Fix it!
	  tlne d,77		;Make sure it's a bp (not an aobjn pointer)
	   hrli d,440700	;Aobjn pointer or something weird, force it
	endif.
	move b,[-2*fnblen,,fnb1]
	call rfnl"rfn
	  nop
	ret

sixnam:	jumpe a,cpopj		;Output sixbit filename with quoting
	push p,b
	movei c,^Q
	do.
	  setz b,
	  rotc a,6
	  addi b,40
	  caie b,":
	   cain b,";
	    idpb c,d
	  cain b,.chspc
	   idpb c,d
	  idpb b,d
	  jumpn a,top.
	enddo.
	pop p,b
	idpb b,d
	ret

$$rfn==1
$$pfn==1
$$merge==1

ifn dbgsw,junk1:constants

.insrt dsk:syseng;rfnl

rfnl"pfnspc:
rfnl"rfnspc:
	popj p,

TSINT:	0
	0
	SKIPL U,TSINT
	 JRST TSFW
	TRNN U,1_CHBOJ+1_CHNETI+1_CHNETO
	 .VALUE
	TRZE U,1_CHBOJ
	 TRO F,FI%BOJ
	TRZE U,1_CHNETI
	 TRO F,FI%NTI
	TRZE U,1_CHNETO
	 TRO F,FI%NTO
	CAME U,[SETZ]
	 .VALUE
	SETOM INT
	.DISMISS TSINT+1

TSFW:	note "A*TSFW*A"
	TRNN U,%PIIOC
	 .VALUE
	.SUSET [.RBCHN,,U]
	CAIE U,CHNETI
	 CAIN U,CHNETO
	  CAIA
	   .VALUE
	TXNN F,F%OPEN
	 .DISMISS [NOGO]	;ERROR CONNECTING => DEV NOT AVAILABLE
	.DISMISS [NTIOC]	;ERROR TRANSFERRING => IOC ERROR

JOBCAL:	SETZ
	SIXBIT /JOBCAL/
	%CLIMM,,CHBOJ
	%CLOUT,,JBCOP
	SETZ [-JBCLEN,,JBC]

JOBSTS:	SETZ
	SIXBIT /JOBSTS/
	%CLIMM,,CHBOJ
	%CLIMM,,43	;SNDSK
	RDEVN
	RDEVN+1
	RDEVN+2
	RDEVN+3
	OPMODE
	SETZ [440700,,SYSNAM]

JBRWIN:	SETZ
	SIXBIT /JOBRET/
	%CLIMM,,CHBOJ
	SETZI 1

JBRET:	SETZ
	SIXBIT /JOBRET/
	%CLIMM,,CHBOJ
	SETZI 0

JBRVAL:	SETZ		;JOBRET a value
	SIXBIT /JOBRET/
	%CLIMM,,CHBOJ
	%CLIMM,,1
	SETZ RETVAL

JBRFNF:	SETZ		;JOBRET error code 4 ("File not found").
	SIXBIT /JOBRET/
	%CLIMM,,CHBOJ
	SETZ [%ENSFL,,0]

JBRERR:	SETZ		;JOBRET AN ERROR CODE.
	SIXBIT /JOBRET/
	%CLIMM,,CHBOJ
	SETZ ERRCOD

PKTOUT:	SETZ
	SIXBIT/PKTIOT/
	%CLIMM,,CHNETO
	SETZI PKTBUF

PKTIN:	SETZ
	SIXBIT/PKTIOT/
	%CLIMM,,CHNETI
	SETZI PKTBUF


;; Assorted subroutines

$$CHAOS==1
$$HSTMAP==1
$$HOSTNM==1
$$SYMLOOK==1
$$HST3==1		;Hosts2 tables are no longer up to date.
$$CONNECT==1
.INSRT DSK:SYSENG;NETWRK >

;Lookup sixbit host in A
sixhst:	camn a,[sixbit/SP/]	;Special dispensation
	 move a,[sixbit/SPEECH/]
	move w,[440700,,buf]
	call wsix
	setz a,
	idpb a,w
	movei a,buf
	callret netwrk"hstlook

DATIME"$$SVNG==1
DATIME"$$ABS==1
.INSRT DSK:SYSENG;DATIME >

ifn dbgsw,[
$note:	exch t,(p)
	ifxe. f,f%dbug
	  pop p,t
	  ret
	endif.
	push p,tt
;t/address of length+string, have push p,t ? push p,tt
	move tt,(t)
	movei t,1(t)
	hrli t,440700
	syscal siot,[%climm,,chtyo ? t ? tt]
	  .Lose %LsSys
$nret:	pop p,tt
	pop p,t
	ret

$nsix:	exch t,(p)
	ifxe. f,f%dbug
	  pop p,t
	  ret
	endif.
	push p,tt
	move t,@(t)
	do.
	  setz tt,
	  rotc t,6
	  addi tt,40
	  .iot chtyo,tt
	  jumpn t,top.
	enddo.
	jrst $nret

$nstr:	exch t,(p)
	ifxe. f,f%dbug
	  pop p,t
	  ret
	endif.
	push p,tt
	move t,(t)
	hrli t,440700
	do.
	  ildb tt,t
	  jumpe tt,$nret
	  .iot chtyo,tt
	  loop.
	enddo.

$nout:	exch t,(p)
	ifxe. f,f%dbug
	  pop p,t
	  ret
	endif.
	push p,tt
	move t,@(t)
	ifl. t
	  .iot chtyo,["-]
	  movns t
	endif.
	call .nout
	pop p,tt
	pop p,t
	ret

.nout:	idivi t,10.
	ifn. t
	  push p,tt
	  call .nout
	  pop p,tt
	endif.
	addi tt,"0
	.iot chtyo,tt
	ret
]


bugchk: ;Dump and send mail and stuff
	die
bug==:call bugchk

CONSTANTS
VARIABLES

BUFL==10000-.	;TRY TO FIT IN 4K
IFL BUFL-2000,BUFL==2000+<BUFL&1777>	;OH, WELL
BUF:	BLOCK BUFL-1
	-1			;Make sure enough core gets dumped.
BUFEND::

HSTPAG==:<.+1777>/2000		;Host tables go here

DEFINE INFORM A,B
PRINTX/A=B
/TERMIN
IF2 INFORM   Buffer size,\bufl
IF2 INFORM   Pages used,\<<.+1777>/2000>

	end begin
