PDP-10.its/src/sysen2/msplit.13

; -*- Midas -*-

title MSPLIT - Split a mail file into smaller pieces.

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7
x=:10
y=:11
z=:12
bc=:13
bp=:14

p=:17

ch==:0,,-1
chttyi==:1
chttyo==:2
chdski==:3
chdsko==:4
chprobe==:5

%fr==:0,,525252
%fl==:1,,525252

call=:pushj p,
return=:popj p,
save==:push p,
rest==:pop p,
flose=:.lose %lsfil
slose=:.lose %lssys
pause=:.break 16,100000
quit=:.logout 1,
tyi=:.iot chttyi,
tyo=:.iot chttyo,

define bltdup org,len
	move tt,[<org>,,<org>+1]
	blt tt,<org>+<len>-1
termin

define syscall name,args
	.call [setz ? .1stwd sixbit /name/ ? args(400000)]
termin

define conc foo,bar
foo!bar!termin

; JSP T,LOSE is like .LOSE %LSSYS(TT) or SLOSE (TT)
lose:	syscall lose,[movei %lssys(tt) ? movei -2(t)]
	 slose

popj1:	aos (p)
cpopj:	return

rfn"$$pfn==:1
rfn"$$rfn==:1
.insrt dsk:syseng;rfn >

rsixtp:	cain a,",
	 aos (p)
psixtp:	return

format"$$pfn==:1
format"pfn==:rfn"pfn
format"$$pcode==:1
.insrt dsk:syseng;format >

outstr:	syscall siot,[movei chttyo ? a ? b]
	 slose
	return

define format &string&,args
	call [
	call $format
.zzz.==-1
irp arg,,[args]
	save arg
.zzz.==.irpcnt
termin
	hrroi a,[ascii string]
	movei b,.length string
	movni c,.zzz.+1
	jrst format"format]
termin

$forma:	save a
	save b
	save c
	call @-3(p)
	rest c
	rest b
	rest a
	rest (p)
	return

.vector pdl(lpdl==:100.)
.vector buffer(lbuffer==:4000)

usrvar:	sixbit /OPTION/	? tlo %opint\%opopc
	sixbit /MASK/	? move [%pipdl]
	sixbit /SNAME/	? movem ifile+3
	sixbit /XUNAME/	? movem ifile+1
	sixbit /OPTION/	? movem a
lusrvar==:.-usrvar

go:	move p,[-lpdl,,pdl-1]
	.open chttyi,[.uai,,'tty ? setz ? setz]
	 slose
	.open chttyo,[.uao\%tjdis,,'tty ? setz ? setz]
	 slose
	move t,[-lusrvar,,usrvar]
	syscall usrvar,[movei %jself ? t]
	 slose
	move t,[ifile,,ofile]
	blt t,ofile+3
	tlnn a,%opcmd
	 jrst go1
	setzm buffer+0
	bltdup buffer,lbuffer-1
	movsi t,(.byte 7 ? ^M ? ^M)
	movem t,buffer+lbuffer-1
	.break 12,[..rjcl,,buffer]
	move d,[440700,,buffer]
	movei b,ifile
	call rfn"rfn
	move t,[ifile,,ofile]
	blt t,ofile+3
	caie a,",
	 jrst go1
	movei b,ofile
	call rfn"rfn
go1:	syscall open,[movsi .bai ? movei chdski ? move ifile+0
			move ifile+1 ? move ifile+2 ? move ifile+3]
	 flose
	syscall rfname,[movei chdski ? movem ifile+0
			movem ifile+1 ? movem ifile+2 ? movem ifile+3]
	 slose
	move a,ifile+2
	lsh a,-6
	tlo a,(sixbit /_/)
	syscall open,[movsi .bai\%donrf\%donlk ? moves tt
			movei chprobe ? move ifile+0
			move ifile+1 ? move a ? move ifile+3]
	 jsp t,go2
	exch a,ifile+2
	movei t,ifile
	format "~&File ~F exists.  Perhaps a crash occured",t
	exch a,ifile+2
	format "~&during a previous attempt to split ~F?",t
	quit

go2:	caie tt,%ensfl
	 jrst lose
	movei t,ifile
	format "~&Renaming ~F",t
	exch a,ifile+2
	format " to be ~F.",t
	syscall renmwo,[movei chdski ? move ifile+1 ? move ifile+2]
	 slose
	setom bufflg
	call newbuf
	jumpe bc,done
	move a,ofile+2
	call sixnrm
loop:	movem a,ofile+2
	syscall open,[movsi .bai\%donrf\%donlk ? moves tt
			movei chprobe ? move ofile+0
			move ofile+1 ? move ofile+2 ? move ofile+3]
	 jsp t,loop1
next:	move a,ofile+2
	call sixaos
	jrst loop

loop1:	caie tt,%ensfl
	 jrst lose
	movei t,ofile
	format "~&Creating ~F.",t
	syscall open,[movsi .uao ? movei chdsko ? move ofile+0
			move ofile+1 ? move ofile+2 ? move ofile+3]
	 flose
	setzi a,
	jrst outlp

out:	syscall siot,[movei chdsko ? move bp ? move bc]
	 slose
	call newbuf
	jumpe bc,done
outlp:	add a,bc
	camge a,size
	 jrst out
	move b,bp
	move c,bc
scan:	ildb t,b
	caie t,^_
	 sojg c,scan
	sojle c,out
	ildb t,b
	caie t,^M
	 sojg c,scan
	sojle c,out
	ildb t,b
	caie t,^J
	 sojg c,scan
	sojl c,out
	exch c,bc
	sub c,bc
	syscall siot,[movei chdsko ? move bp ? move c]
	 slose
	jumpg bc,next
	call newbuf
	jumpg bc,next
done:	movei t,ifile
	format "~&Deleting ~F.",t
	syscall delewo,[movei chdski]
	 slose
	quit

.scalar bufflg			; -1 if nothing held

newbuf:	move bp,[440700,,buffer]
	move buffer+lbuffer-1
	movem buffer+0
	move t,[-<lbuffer-1>,,buffer+1]
	aosn bufflg
	 move t,[-lbuffer,,buffer]
	.iot chdski,t
	jumpl t,newbf1
	movei bc,5*<lbuffer-1>
	return

newbf1:	setom bufflg		; Nothing held back now...
	movei bc,-buffer(t)
	jumpe bc,cpopj
	imuli bc,5
	ldb tt,[.bp <177_1>,-1(t)]
	caie tt,^C
	 cain tt,^@
	  soja bc,.+2
	   return
	ldb tt,[.bp <177_8>,-1(t)]
	caie tt,^C
	 cain tt,^@
	  soja bc,.+2
	   return
	ldb tt,[.bp <177_15.>,-1(t)]
	caie tt,^C
	 cain tt,^@
	  soja bc,.+2
	   return
	ldb tt,[.bp <177_22.>,-1(t)]
	caie tt,^C
	 cain tt,^@
	  soj bc,
	return

sixaos:	move t,a
	andi t,77
	cail t,'A
	 caile t,'Z
	  jrst sixao1
	aos a
	caie t,'Z
	 return
	lsh a,-6
	call sixaos
	lsh a,6
sixao1:	trz a,77
	tro a,'A
	return

sixnrm:	movei t,77
	movei tt,'A
sixnr1:	tdne a,t
	 return
	tdo a,tt
	lshc t,6
	jrst sixnr1

tsint:
loc 42
	-ltsint,,tsint
loc tsint
	400000,,p
ltsint==:.-tsint

dismis:	setz ? sixbit /DISMIS/ ? movsi 400000 ? setz p

size:	5*2000*30.		; Aim for 30 blocks

cnstnts:
constants
variables

ifile:	sixbit /DSK/
	-1
	sixbit /MAIL/
	-1

ofile:	block 4

patch::
pat:	block 100.
epatch:	-1			; Make memory exist, end of patch area

ffaddr:
ffpage==:<ffaddr+1777>_-12

end go