// 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()
]