// EarsTransmit.Sr

// Last modified November 30, 1979  10:19 AM by Taft

get "altofilesys.d"

structure SB:
	[ cch	byte
	ch^0,255	byte
	]

structure SL:
	[ cch	word
	ch^0,10000	byte
	]

structure FUNFA:
	[
	fun	byte;
	fa byte;
	]

structure FDA:
	[
	track	bit	13;
	sector	bit	3;
	] 

structure OF:
	[ 
	macfp	word;
	version	word = fileid	word = dests	word;
	sn1	word;
	sn2	word;
	wmode	word;
	wf	word;
	macpos	word;
	pos	word;
	bphint	word;
	macbi 	word = macbp	word;
	formatted	word = clearance	word;
	fda	@FDA;
	rgda	word = rvrgbp	word;
	last	word;
	] 

structure BS:
	[
	dirty	bit 1
	falloced	bit	1
	blank	bit 14
	]

get "ho.df"

//get "q.df"
structure Q:
	[ head	word
	tail	word
	] 
manifest	[ 
	lQ = (size Q)/16
	] 

get "ears.df"
get "dir.df"
get "vm.df"
get "PupEftp.Decl"
get "rn1.df"
get "font.df"
//get "st.df"

//incoming procedures
external	[
	InitPupLevel1
	array
	array1
	OpenEFTPSoc
	Enqueue
	InitializeContext
	AllocVm
	CallContextList
	DestroyInterrupt
	StartIO
	SetRegionSys
	SetRegionW
	updatedisplay
	Block
	macfe
	chknilfunfa
	lfm
	min
	move
	movec
	makecfa
	makefp
	ScanPages
	Dequeue
	ugt
	Dismiss
	SendEFTPBlock
	endofkeystream
	getchar
	CloseEFTPSoc
	SendEFTPEnd
	relvm
	GetPartner;
	]

//outgoing procedure
external EarsTransmit

//incoming statics
external	[
// 	vSDD
	freee
	lvUserFinishProc
	DefaultArgs
	DefaultArgs1
	macfsn
	mpfsnfs
	macbp
	rgvpa
	rgbs
	rglastused
	vrlwsys
	]

//outgoing statics
external	[
	Call0
	Call1
	Call2
	Call3
	]
	
//local statics
static	[
	Call0
	Call1
	Call2
	Call3
	FDBuf
	EFTPSocket
	qBufRead
	qBufFree
	qBufFree2
	qBufEther
	c2bufs
	pagessent
	sbr
	fUpDisp
	massagedone
	putetherdone
	vho
	cpages
	fp
	ridHostName
	]
	
//local manifest
manifest	[
	blocktimeout= 500
	endtimeout= 500
	risysstate= 1
	risyspast= 3
	dummyzone= 0
	numEFTPBufs= 4	
	numQbufs= 5
	numQ2bufs= 3
	Ears= 3 lshift 8 + 3
	Szonesize= #500
	Pzonesize= #700
	Mzonesize= #400
	eBLoc= #601
	fmPassword=#20200
	cNonFmWords= 64 + 1024 + 512
	lFDE= 4
	]

//-=-=-=-=-=-=-=-=-=-
let EarsTransmit(fptr, pgnMac, ho) = valof
//-=-=-=-=-=-=-=-=-=-

[
vho = ho
cpages=pgnMac	//number of pages(counting 0)
fp= fptr
if ho>> HO.fEars eq false then macfsn = 0;

let FontDir= nil
let savefreee = freee
let savedUFP = @lvUserFinishProc
let EFTPCtxq = nil
let poolBuf= nil
// netAddress!0 = GetNetAddress(lv (vho>>HO.aslNetAddress));
// netAddress!1 = 0;
// netAddress!2 = #20;	// well known port for EFTP servers

DefaultArgs = DefaultArgs1
Call0= table	[
    #55001	// sta 3 1 2
   #115000	// mov 0 3
    #35400	// lda 3 0 3
     #1401	// jmp 1 3
	]
Call1= table	[
    #55001	// sta 3 1 2
   #115000	// mov 0 3
    #35401	// lda 3 1 3
     #1401	// jmp 1 3
	]
Call2= table	[
    #55001	// sta 3 1 2
   #115000	// mov 0 3
    #35402	// lda 3 2 3
     #1401	// jmp 1 3
	]
Call3= table	[
    #55001	// sta 3 1 2
   #115000	// mov 0 3
    #35403	// lda 3 3 3
     #1401	// jmp 1 3
	]

[		//start repeat loop
FDBuf= array(lBuf)
if macfsn>0 then FontDir= array1(256,0)
unless CreateFontDir(FontDir) do resultis false

EFTPCtxq = array1(2,0)       //init context queue

InitPupLevel1(dummyzone,EFTPCtxq,numEFTPBufs)


Enqueue(EFTPCtxq,InitializeContext(array(Szonesize),
	Szonesize,callscan))
Enqueue(EFTPCtxq,InitializeContext(array(Mzonesize),
	Mzonesize,massage))
Enqueue(EFTPCtxq,InitializeContext(array(Pzonesize),
	Pzonesize,PutEther))

qBufRead= array1(lQ,0)	//scanpages puts data here
qBufEther= array1(lQ,0)  //massage puts it here and putether sends it

qBufFree= array1(lQ,0)  //available to scanpages
poolBuf= array(numQbufs * lBuf)
AllocVm(qBufFree,poolBuf, numQbufs, true)

qBufFree2= array1(lQ,0)  //available to scanpages
poolBuf= array(numQ2bufs * lBuf)
AllocVm(qBufFree2,poolBuf, numQ2bufs, true)
c2bufs= numQ2bufs

pagessent = 0
massagedone= false
putetherdone= false

SetRegionW(vrlwsys, 0, lv vho>>HO.asbNetAddress)
ridHostName = rinil
ridHostName<<RID.nrl = 1; ridHostName<<RID.ri = 0

until putetherdone do
	[
	CallContextList(EFTPCtxq!0)
	if fUpDisp then updatedisplay()
	]

for bp= 0 to macbp - 1 do
	[
	if rgvpa!bp eq -1 then 
		[
		(rgbs!bp)<<BS.dirty = false
		rglastused!bp = 0
		]
	]

@lvUserFinishProc=savedUFP
DestroyInterrupt(@eBLoc)
@eBLoc=0
StartIO(3)

if sbr ge 0 then resultis true

if sbr eq -4 then 	//error during transmission-  restart
	[
	SetRegionSys(risysstate,178)
	SetRegionSys(risyspast,177,180)
	updatedisplay()
	freee= savefreee
	loop
	]
if sbr eq -10 then 	//server not found
	[
	SetRegionSys(risyspast, 239, 50)
	resultis false
	]

//only gets here if aborted (DEL)
SetRegionSys(risyspast,13,50)
resultis false
] repeat
]

//-=-=-=-=-==-===-=-==
// and GetNetAddress(sl) = valof
//-=-=-=-=-==-===-=-==
//result is net address in numeric form
//argument is in form "n#nnn" (or "n#nn" or "n#n")
//a#b = 256a + b
// [
// let netAddress = nil
// let dig = nil
// let net = sl>>SL.ch^0 -$0
// let host = 0
// for ich = 2 to sl>>SL.cch-1 do
// 	[ dig = sl>>SL.ch^ich - $0
// 	if dig ls 0 % dig gr 9 then break
// 	host = host lshift 3 + dig
// 	]
// netAddress = net lshift 8 + host 
// resultis netAddress
// ]




//-=-=-=-=-==-===-=-==
and getbuf(q) = valof
//-=-=-=-=-==-===-=-==
//waits for an item from the queue, Blocks meanwhile
//result is the item from the queue
[
let item = 0
while item eq 0 do 
	[ item = Dequeue(q); Block() ]
resultis item
]


//-=-=-=-=-=-=-=-=-=-=-
and tcBlock(x,y) = valof
//-=-=-=-=-=-=-=-=-=-=-=-

[ Block();  resultis tcToYou  ]

//-=-==--=-=-=-=-==-=-
and updateFS(scwfm,fsoffset) be
//-=-=-=-=-=-=--=-=-=-=
//updates and sends the FS
//unless fsoffset=0, shift to even page boundaries
//SCWFM= number to add to address field
//FSOFFSET= word in page where FS starts

[ 
test fsoffset eq 0 
ifso for t=1 to 2 do
	[
	let tbuf= getbuf(qBufRead)
	for i=tbuf>>BUF.ca + 3 to tbuf>>BUF.ca + 255 by 4 do
	 rv(i) = rv(i) + scwfm
	Enqueue(qBufEther, tbuf)
	]
ifnot 	[
	let tbuf1=getbuf(qBufRead)
	let tbuf2=getbuf(qBufRead)
	let tbuf3=getbuf(qBufRead)
	let ca1=tbuf1>>BUF.ca
	let ca2=tbuf2>>BUF.ca
	let ca3=tbuf3>>BUF.ca

	move(ca1+fsoffset,ca1,256-fsoffset)
	move(ca2,ca1+256-fsoffset,fsoffset)
	move(ca2+fsoffset,ca2,256-fsoffset)
	move(ca3,ca2+256-fsoffset,fsoffset)

	for i=ca1+3 to ca1+255 by 4 do rv(i)=rv(i)+scwfm
	for i=ca2+3 to ca2+255 by 4 do rv(i)=rv(i)+scwfm

	Enqueue(qBufEther,tbuf1)
	Enqueue(qBufEther,tbuf2)
	Enqueue(qBufFree,tbuf3)
	]	
]

// //-=-=-=-=-==-===-=-==
// and updateDD(DDBuf) be 
// //-=-=-=-==-=-=-==--=-=
// // only called for Ears files
// [
// Block()
// let cafd = FDBuf>>BUF.ca
// let cadd = DDBuf>>BUF.ca
// movec(cadd+#20,cadd+#23,0)     //reserved for PUB, zero otherwise
// 
// if macfsn eq 0 then return
// 
// rv(cadd+#11)=1			//length of FD
// let FDElast = lFDE*(macfsn-2)	//0th FS doesn't count
// 
// let strecfm = rv(cafd + FDElast)
// let crecfm = rv(cafd + FDElast + 1)
// let crecfs = rv(cafd + FDElast + 2)
// 
// let crecfonts= strecfm + crecfm + crecfs
// let crecfontdir = 1
// rv(cadd+1)= rv(cadd+1) + crecfonts + crecfontdir
// 
// move((lv vho>>HO.aslPrintBy) + 1,cadd+#232,#20);
// //fake cadd+#231 as an SL and add EOL character
// let cch = (lv (vho>>HO.aslPrintBy))>>SL.cch
// if cch>#37  then cch = #37
// (cadd+#231)>>SL.ch^cch = #376
// ]

//-=-=-=-=-=-=-=-=-=-=-=-=-=--
and CreateFontDir(FontDir) = valof
//-=-=-=-=-=-=-=-=-=-=-=-=-=--=
//4-word entry for each FS
//		0: Starting record (page) of FM (rel 1st FM) = strecfm
//		1: Number of records in FM = crecfm
//		2: Number of records in FS = crecfs
//		3: ttytab=0
//Creates 256-word array FontDir and buffer FDBuf 
//Each set FM starts with extra word #20200, so 1 extra word is
//		included in word count
//0th FM doesn't count, so FS^i goes in fontdir^(i-1)
[
let strecfm = 0
let tfs = nil
let crecfs = nil
let crecfm = nil
let cwfm= nil
let tfunfa=nil
let fd=nil
let fdh=nil

for fsn = 1 to macfsn - 1 do	//0th FS doesn't count
	[ 
	tfs = mpfsnfs!fsn	
	cwfm=0
	crecfm=0
	crecfs = 0
	for fe = 0 to macfe(tfs) -1 do  
		[ 
		if chknilfunfa(tfs,fe) then
			[ crecfs = crecfs + 2; loop ]
		cwfm= cwfm + lfm(tfs,fe)
		crecfm= (1 + cwfm + 255) rshift 8	//div 256
		crecfs = crecfs + 2 
		if ugt(crecfm, 128) then 
			[
			SetRegionSys(risyspast,169,50)
			SetRegionSys(risysstate,215)
			resultis false
			]
		]  

	FontDir>>FONTDIR.strecfm^(fsn-1) = strecfm
	FontDir>>FONTDIR.crecfm^(fsn-1) = crecfm
	FontDir>>FONTDIR.crecfs^(fsn-1) = crecfs
	FontDir>>FONTDIR.ttytab^(fsn-1) = 0   

	strecfm = strecfm + crecfm + crecfs
	]

//now create a buffer

FDBuf>>BUF.ca = FontDir

resultis true
]



//-=-=-=-=-=-=-=-=-=-
and massage() be
//-=-=-=-=-=-=-=-=-==
//takes data off qBufRead and enqueues it on qBufEther
//Send pages 3 - (DD - 1) of main file
//For each FS,
// --Send all font FM's
// --Filler to round out page
// --Update font FS's - add start of font FM (words) to each
//		character address entry
// --Send all font FS's (these are round already)
//Update Document Directory
//Send Document Directory
//
//Set done flag   

//ears file has 2 garbage pages at start, press file does not

//for press file, macfsn must be 0, vho.fEars must be false

[
let tfs=nil
let scwfm=0
let cwfmleft=0
let fsoffset=0
let tbuf=0
let DDBuf=0
let tfunfa=nil
let tbuf1=nil
let tbuf2=nil
let ca1=0; let ca2=0; let c1l=0; let c2f=0; let c2l=0
//cai= core address of tbufi
//cil= buffer relative address of first unoccupied word
//cif= buffer relative address of first occupied word

//1st 2 pages are garbage for ears
//last is Doc Dir
//test vho>>HO.fEars 
//	ifso for t=1 to 2 do Enqueue(qBufFree,getbuf(qBufRead))
//	ifnot
	for t=1 to 2 do Enqueue(qBufEther,getbuf(qBufRead))
for t=3 to cpages-2  do  Enqueue(qBufEther,getbuf(qBufRead))

DDBuf=getbuf(qBufRead)	//cpages-1 page is DD
//if vho>>HO.fEars then updateDD(DDBuf)
Block()

if macfsn eq 0 then 
	[ 
	Enqueue(qBufEther,DDBuf)
	massagedone=true
	Block() repeat 
	]

Enqueue(qBufEther,FDBuf)

for fsn= 0 to macfsn-1 do
	[ 
	Block()
	tfs=mpfsnfs!fsn

	if macfe(tfs) eq 0 then loop

	tbuf1=getbuf(qBufFree2)
	c2bufs=c2bufs-1
	ca1=tbuf1>>BUF.ca
	rv(ca1)=fmPassword
	c1l=1

	for fe=0 to macfe(tfs) - 1 do
		[ 
		Block()
		if chknilfunfa(tfs,fe) then loop
		cwfmleft= lfm(tfs,fe)
		c2f=64		//FM starts on word 64 of page 5

		while cwfmleft ne 0 do
			[ 
			tbuf2=getbuf(qBufRead)
			ca2=tbuf2>>BUF.ca
			c2l= min(256,cwfmleft + c2f)
			cwfmleft=cwfmleft - min(cwfmleft,256-c2f)
			test (c2l-c2f+c1l) ge 256
			ifso	[ 
				move(ca2+c2f,ca1+c1l,256-c1l)
				Enqueue(qBufEther,tbuf1)
				move(ca2+c2f+256-c1l,ca2,256)  //overkill
				tbuf1=tbuf2
				ca1=tbuf1>>BUF.ca
				c1l=c2l-c2f+c1l-256
				]
			ifnot	[ 
				move(ca2+c2f,ca1+c1l,c2l-c2f)
				c1l=c1l+c2l-c2f
				Enqueue(qBufFree,tbuf2)
				]
			c2f=0
			]
		]
	if c1l ne 0 then Enqueue(qBufEther,tbuf1)

//now do fs's
//keep track of scwfm to update the FS

	scwfm = 1		//fmPassword 
	for fe= 0 to macfe(tfs) -1 do  
		[  
		Block()
		if chknilfunfa(tfs,fe) then
			[
			//send 512 words for nil FS- any words will do
			Enqueue(qBufEther,getbuf(qBufFree2))
			Enqueue(qBufEther,getbuf(qBufFree2))
			c2bufs=c2bufs-2
			loop
			]

		fsoffset= (lfm(tfs,fe) + cNonFmWords) rem 256

		updateFS(scwfm,fsoffset)	//update and SEND FS

		scwfm= scwfm + lfm(tfs,fe)
		]

	]


Enqueue(qBufEther,DDBuf)

massagedone = true

Block() repeat
]


//-=-=-=-=-==-===-=-==
and callscan() be 
//-=-=-=-==-=-=-==--=-=
[
let cfa= vec lCFA
let tfs=0
let cpfs=0
let cpfsfirst=0
let cpfm = 0;
let tfunfa=0
let tfp= vec 5

makecfa(cfa,fp)
ScanPages(cfa,qBufFree,tcBlock,0,cpages,qBufRead) 

for fsn= 0 to macfsn-1 do
	[ 
	tfs= mpfsnfs!fsn
	for fe = 0 to macfe(tfs) -1 do  
		[ 
		Block()
		if chknilfunfa(tfs,fe) then loop
		cpfm=  (lfm(tfs,fe)+ cNonFmWords +255)/256 -6
		makefp(tfp,tfs,fe)
		makecfa(cfa,tfp,5,(lv(tfs>>FS.rvmpfedafm))!fe)
		ScanPages(cfa,qBufFree,tcBlock,0,cpfm,qBufRead) 
		]
	for fe = 0 to macfe(tfs) -1 do
		[ 
		Block()
		if chknilfunfa(tfs,fe) then loop
		test (lfm(tfs,fe)+cNonFmWords) rem 256 eq 0 
		 ifso cpfs=2 ifnot cpfs=3
		cpfsfirst=(lfm(tfs,fe)+cNonFmWords)/256 -1
		makefp(tfp,tfs,fe)
		makecfa(cfa,tfp,cpfsfirst,(lv(tfs>>FS.rvmpfedafs))!fe)
		ScanPages(cfa,qBufFree,tcBlock,0,cpfs,qBufRead)
		]
	]
Block() repeat
]

//-=-=-=-=-=-========-
and PutEther() be
//-=-=-==-=-=-==-=-==-=
//takes buffers off qBufEther, sends them via EFTP, and returns the
//		buffers to qBufFree  
//if qBufEther is empty (buf=0) check massagedone- if massage is 
//		done, so is PutEther
[
let message=0
let buf=0
// netAddress!0 = GetNetAddress(lv (vho>>HO.aslNetAddress))
// netAddress!1 = 0
// netAddress!2 = #20	// well-known socket number for EFTP 
let netAddress = vec 3;
unless GetPartner(lv (vho>>HO.asbNetAddress), 0, netAddress, 0, #20) then
	[  putetherdone = true;
	sbr = -10
	Block();
	];
EFTPSocket = array(lenEFTPSoc)
OpenEFTPSoc(EFTPSocket,0,netAddress)
Dismiss(100)

[
fUpDisp= false
buf= Dequeue(qBufEther)

test buf eq 0
	ifso 	test massagedone   
		ifso PutEtherEnd()
		ifnot Block()
	ifnot	[
		L6:
		sbr =SendEFTPBlock(EFTPSocket,buf>>BUF.ca,512,blocktimeout) 

		unless endofkeystream() do
		if getchar() eq $*177 then 
			[
			sbr= -5
			CloseEFTPSoc(EFTPSocket)
			putetherdone= true
			Block()
			]

		if sbr ls 0 then 	//error from sendblock
			[
			if pagessent ne 0 then 
				[ sbr= -4; PutEtherEnd() ]
			message = selecton sbr into
				[  case -1: 170;
				case -2: 171;
				default: 172
				]
			SetRegionSys(risyspast,ridHostName,message,180)
			SetRegionSys(risysstate,178)
			fUpDisp= true

			CloseEFTPSoc(EFTPSocket)
			OpenEFTPSoc(EFTPSocket,0,netAddress)
			Dismiss(200)
			goto L6
			]

		//transmission proceeding
		if pagessent eq 0 then
			[
			SetRegionSys(risyspast, 179, ridHostName, 249)
			SetRegionSys(risysstate, 178)
			fUpDisp= true
			Block()
			]

		pagessent = pagessent + 1  
		test c2bufs ls 2
		ifso [ Enqueue(qBufFree2,buf); c2bufs=c2bufs+1 ]
		ifnot Enqueue(qBufFree,buf)
		]

] repeat

]


//-=-=-=-=-==-=-===-==-
and PutEtherEnd() be
//-=-=-=-==-=-=-==-=-=-
[
SendEFTPEnd(EFTPSocket,endtimeout)
CloseEFTPSoc(EFTPSocket)
putetherdone = true
Block()
]