Title Piggy - see piggy.hlp
search MONSYM,MACSYM
.require SYS:MACREL
f=0
t4=<t3=<t2=<t1=1>+1>+1>+1
q4=<q3=<q2=<q1=t4+1>+1>+1>+1
state=q4+1
rtot=state+1
stot=rtot+1
rchr=stot+1
schr=rchr+1
mappag==200
maxpkt=="~"-" "+2
define ermsg (msg) <
 call [tmsg <
>
hrroi t1,[asciz/?'msg/]
movem t1,errptr 
PSOUT%
tmsg <
>
ret]>
define kermsg (msg) <
$count=0
irpc msg,<$count=$count+1>
call [movei t1,"E"
move t2,pktnum
movei t3,$count+^d13 
move t4,[point 7,[asciz/?Kermit-20:  'msg/]] 
movem t4,errptr 
call spack
 nop
tmsg <
?Kermit:  'msg
>
ret]
>
define %jserr (msg,label) <
erjmp [tmsg <
?Kermit:  'msg>
ifnb <msg>,<call jserr0>
ifb <msg>,<call jsmsg0>
ifb <label>,<HALTF%
jrst .+1
>
ifnb <label>,<jrst label>
      ]
>
jserr0:movei t1,.priin
CFIBF%
move t1,diajfn
DOBE%
tmsg < - >
jsmsg0:move t1,diajfn
hrloi t2,.fhslf
setz t3,
ERSTR%
 jfcl
 jfcl
tmsg <
>
ret
define %jsker (msg,label) <
erjmp [move t1,[point 7,[asciz/?Kermit-20:  'msg   /]] 
movem t1,errptr 
call %%krms
tmsg <
?Kermit:  'msg>
ifnb <msg>,<call jserr0>
ifb <msg>,<call jsmsg0>
ifb <label>,<HALTF%
jrst .+1
>
ifnb <label>,<jrst label>
      ]
>
%%krms:move t3,[point 7,%%krbf] 
setz t4,
%%krm1:ildb t2,t1
jumpe t2,%%krm2
addi t4,1
idpb t2,t3
jrst %%krm1
%%krm2:move t1,t3
hrloi t2,.fhslf
movei t3,^d80
sub t3,t4
ERSTR%
 trn
 trn
move t2,t1
move t1,[point 7,%%krbf] 
call subbp
 movei t3,^d80
movei t1,"E"
move t2,pktnum
move t4,[point 7,%%krbf] 
call spack
 trn
ret
start:RESET
move p,[iowd 100,pdl] 
call pinit
GJINF%
movem t4,pars3
call $setln
movx t1,.nulio
movem t1,diajfn
call $recv
haltf

$setln:stkvar <oldjfn>
move t1,netjfn
movem t1,oldjfn
move t1,[170700,,filbuf] 
move t2,[ascii/TTY/]
movem t2,filbuf
move t2,pars3
movem t2,ttynum
movei t3,^d8
NOUT%
 erjmp [ermsg <UTAT>
ret]
movei t2,":"
idpb t2,t1
setz t2,
idpb t2,t1
movx t1,gj%sht
hrroi t2,filbuf
GTJFN%
 erjmp [ermsg <UTAT>
ret]
hrrzm t1,netjfn
movx t2,fld(8,of%bsz)!of%wr!of%rd 
skipe igpar
 movx t2,fld(7,of%bsz)!of%wr!of%rd 
OPENF%
 erjmp [movei t1,.fhslf 
GETER%
hrrzs t2
caie t2,opnx7
 jrst [ermsg <UTAT>
move t2,oldjfn
movem t2,netjfn
ret]
tmsg <IUBJ>
move t1,netjfn
move t2,oldjfn
movem t2,netjfn
DVCHR%
 erjmp r
hlre t2,t3
movei t1,.priou 
movei t3,^d10
NOUT%
 erjmp r
ret]
move t1,oldjfn
jumpe t1,$stln2
CLOSF%
 %jserr (,.+1)
$stln2:move t1,netjfn
movei t2,.chcrt
BOUT%
 %jserr (,r)
ret

$recv:setzb stot,rtot
setzb schr,stchr
setzb rchr,rtchr
setzm errptr
call inilin
call ccon
 ret
setzm pktnum
movei state,"R"
setzm numtry
$recv2:move t1,diajfn
move t2,pktnum
movei t3,^d10
NOUT%
 jrst .+1
cain state,"D"
 jrst [call rdata
jrst $recv2]
cain state,"F"
 jrst [move t1,filjfn
call rfile
jrst $recv2]
cain state,"R"
 jrst [call rinit
jrst $recv2]
cain state,"C"
 jrst [call reslin
GTAD%
subm t1,stdat
ret]
cain state,"A"
 jrst [call reslin
GTAD%
subm t1,stdat
ret]
ret
rinit:saveac <q1>
move q1,numtry
caml q1,imxtry
 jrst [ ermsg <UTRI
>
movei state,"A" 
ret]
addi q1,1
movem q1,numtry
call rpack
 ret
move q1,t1
GTAD%
movem t1,stdat
cain q1,"S"
 jrst [movem t2,pktnum 
call spar
move t4,[point 8,data] 
call rpar
movei t1,"Y"
move t2,pktnum
move t4,[point 8,data] 
call spack
 jrst [movei state,"A" 
ret]
move t2,numtry 
movem t2,oldtry 
setzm numtry
move t2,pktnum 
addi t2,1
dpb t2,[point 6,pktnum,35] 
movei state,"F" 
ret]
move t2,pktnum
call nak
ret
rfile:saveac <q1,q2>
move q1,numtry
caml q1,maxtry
 jrst [ ermsg <UTRFH
>
movei state,"A" 
ret]
addi q1,1
movem q1,numtry
move q1,t1
move q2,t2
call rpack
 ret
cain t1,"S"
 jrst [move q1,oldtry
caml q1,imxtry
 jrst [ ermsg <UTRI
>
movei state,"A" 
ret]
addi q1,1
movem q1,oldtry 
move q1,pktnum 
caie t2,-1(q1)
 jrst [ ermsg <ERP
>
movei state,"A" 
ret]
setzm numtry
move t4,[point 8,data] 
call rpar
movei t1,"Y"
move t4,[point 8,data] 
call spack
 jrst [movei state,"A" 
ret]
ret]
cain t1,"Z"
 jrst [move q1,oldtry
caml q1,maxtry
 jrst [ ermsg <UTRE
>
movei state,"A" 
ret]
addi q1,1
movem q1,oldtry 
move q1,pktnum 
caie t2,-1(q1)
 jrst [ ermsg <IEPR
>
movei state,"A" 
ret]
setzm numtry
movei t1,"Y"
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
ret]
cain t1,"F"
 jrst [came t2,pktnum
 jrst [ ermsg <IP
>
movei state,"A" 
ret]
move t1,t4
move t2,t3
call gofil
 jrst [movei state,"A" 
ret]
movem t1,filjfn 
movei t1,"Y"
move t2,pktnum
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
move t1,filjfn
movx t2,fld(7,of%bsz)!of%wr 
skipe ebtflg 
 movx t2,fld(8,of%bsz)!of%wr 
OPENF%
 erjmp [kermsg <UOF
>
move t1,filjfn
RLJFN%
 erjmp .+1 
setzm filjfn 
movei state,"A" 
ret]
setzm mapflg
move t2,numtry 
movem t2,oldtry 
setzm numtry
move t2,pktnum 
addi t2,1
dpb t2,[point 6,pktnum,35] 
movei state,"D" 
ret]
cain t1,"B"
 jrst [came t2,pktnum
 jrst [ ermsg <IP
>
movei state,"A" 
ret]
movei t1,"Y"
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
movei state,"C" 
ret]
cain t1,"T"
 jrst [movei t1,"N"
move t2,pktnum
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
ret]
movei state,"A"
ret
rdata:saveac <q1,q2>
move q1,numtry
caml q1,maxtry
 jrst [ ermsg <UTRD
>
jrst rdterr]
addi q1,1
movem q1,numtry
move q1,t1
move q2,t2
call rpack
 ret
cain t1,"D"
 jrst [came t2,pktnum
 jrst .+1
move t1,t4
move t2,t3
call ptchr
 jrst rdterr
movei t1,"Y"
move t2,pktnum
setzb t3,t4
call spack
 jrst rdterr
move t2,numtry 
movem t2,oldtry 
setzm numtry
move t2,pktnum 
addi t2,1
dpb t2,[point 6,pktnum,35] 
ret]
cain t1,"D"
 jrst [move q1,oldtry
caml q1,maxtry
 jrst [ ermsg <UTRD
>
jrst rdterr] 
addi q1,1
movem q1,oldtry 
move q1,pktnum 
caie t2,-1(q1)
 jrst [ ermsg <ERD
>
 jrst rdterr] 
setzm numtry
movei t1,"Y"
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
ret]
cain t1,"F"
 jrst [move q1,oldtry
caml q1,maxtry
 jrst [ ermsg <UTAFH
>
 jrst rdterr] 
addi q1,1
movem q1,oldtry 
move q1,pktnum 
caie t2,-1(q1)
 jrst [ ermsg <ERFH
>
 jrst rdterr] 
setzm numtry
movei t1,"Y"
setzb t3,t4
call spack
 jrst rdterr
ret]
cain t1,"Z"
 jrst [came t2,pktnum
 jrst [ ermsg <IER
>
movei state,"A" 
ret]
movei t1,"Y"
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
skipe mapflg
 jrst [movx t1,<.fhslf,,mappag> 
hrl t2,filjfn 
hrr t2,prepag
movx t3,pm%rd!pm%wr 
PMAP%
  %jsker (,r)
setzm mapflg 
jrst rd1]
rd1:movx t1,co%nrj
hrr t1,filjfn
CLOSF%
 erjmp rd2
movx cf%nud
hrli t1,.fbsiz
ior t1,[cf%nud]
hrr t1,filjfn
seto t2,
move t3,rchr
CHFDB%
 erjmp rd12
rd12:hrli t1,.fbbyv
hrr t1,filjfn
move t2,[007700,,0] 
move t3,[000700,,0] 
skipe ebtflg
 move t3,[001000,,0] 
CHFDB%
 erjmp rd2
rd2:hrr t1,filjfn
RLJFN%
 nop
setzm filjfn
addm rchr,rtchr 
setz rchr,
move t2,numtry 
movem t2,oldtry 
setzm numtry
move t2,pktnum 
addi t2,1
dpb t2,[point 6,pktnum,35] 
movei state,"F"
ret]
cain t1,"T"
 jrst [movei t1,"N"
move t2,pktnum
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
ret]
rdterr:movx t1,cz%abt
hrr t1,filjfn
CLOSF%
 erjmp .+1
setzm filjfn
movei state,"A"
ret
nak:movei t1,"N"
setzb t3,t4
call spack
 jrst [movei state,"A" 
ret]
ret
spar:
ildb t2,t4
subi t2," "
movem t2,spsiz
ildb t2,t4
subi t2," "
movem t2,stimou
ildb t2,t4
subi t2," "
movem t2,spadnm
ildb t2,t4
addi t2,^o100
andi t2,^o177
movem t2,spadch
ildb t2,t4
subi t2," "
movem t2,seolch
ildb t2,t4
movem t2,squote
ret
rpar:saveac <q1>
move q1,rpsiz
addi q1," "
idpb q1,t4
move q1,rtimou
addi q1," "
idpb q1,t4
move q1,rpadnm
addi q1," "
idpb q1,t4
move q1,rpadch
addi q1,^o100
andi q1,^o177
idpb q1,t4
move q1,reolch
addi q1," "
idpb q1,t4
move q1,rquote
idpb q1,t4
movei t3,6
ret
gtchr:saveac <q1,q2,q3,q4>
stkvar <len,tmpac>
subi t1,1
movem t1,len
skipe eoflag
 jrst [setz t1,
setzm eoflag
ret]
skipn mapflg
 jrst [move t1,filjfn
movx t2,<2,,.fbbyv> 
movei t3,filpag 
GTFDB%
 %jsker (Unable to get file length,r) 
skipn filbyt
 jrst [setom eoflag 
setz t1,
retskp]
ldb t2,[point 6,filpag,11] 
movem t2,filbsz 
skipe ebtflg
 jrst [cain t2,^d8 
 jrst gtc 
movei t3,^d36 
idiv t3,t2 
move q1,filbyt
idiv q1,t3 
imuli q1,4 
movem q1,filbyt 
jrst gtc]
caie t2,7
 jrst [movei t3,^d36 
idiv t3,t2 
move q1,filbyt
idiv q1,t3 
imuli q1,5 
movem q1,filbyt 
jrst gtc]
gtc:hrlzs t1
hrlm t1,filpag
movx t2,<.fhslf,,mappag> 
movx t3,pm%rd
PMAP%
  %jsker (Unable to map in file page,r) 
move q4,[point 7,mappag*1000]
skipe ebtflg
 move q4,[point 8,mappag*1000] 
setzm prepag
setom mapflg
jrst gtchr1]
move q4,mapptr
gtchr1:setz q1,
move q2,[point 8,data] 
gtchr2:caml q1,len
 jrst [move t1,q1
movem q4,mapptr 
retskp]
caml schr,filbyt
 jrst [setom eoflag
seto t1,
movx t2,<.fhslf,,mappag> 
setz t3,
PMAP%
 %jsker (Error unmapping page,r)
setzm mapflg
move t1,q1
retskp]
ildb t2,q4
movei t1,<mappag+1>*1000 
caig t1,(q4)
 jrst [seto t1,
movx t2,<.fhslf,,mappag> 
setz t3,
PMAP%
 %jsker (Error unmapping page,r)
move t1,prepag
addi t1,1
caml t1,filpag
 jrst [setom eoflag 
move t1,q1 
setzm mapflg 
retskp]
movem t1,prepag 
hrl t1,filjfn
movx t2,<.fhslf,,mappag> 
movx t3,pm%rd
PMAP%
  %jsker (Unable to map in the file,r) 
move q4,[point 7,mappag*1000]
skipe ebtflg
 move q4,[point 8,mappag*1000] 
ildb t2,q4
jrst .+1]
addi schr,1
addi q1,1
movem t2,tmpac
andi t2,^o177
cail t2," "
 cain t2,.chdel
  jrst [move q3,squote
addi q1,1
idpb q3,q2
move t2,tmpac
xori t2,^o100
jrst gtchr3]
camn t2,squote
 jrst [addi q1,1
idpb t2,q2
jrst .+1]
move t2,tmpac
gtchr3:move q3,schr
skipe ebtflg
 jrst gtchr4
movem q4,tmpac
idivi q3,5
skipn q4
 jrst [hrr q4,tmpac
move q4,(q4)
andi q4,1
lsh q4,7
ior t2,q4
jrst .+1]
move q4,tmpac
gtchr4:idpb t2,q2
jrst gtchr2
ptchr:saveac <q1,q2,q3,q4>
stkvar <siz,tmp>
movem t2,siz
move q1,t1
move q2,t2
skipn mapflg
 jrst [move q3,[point 7,mappag*1000]
skipe ebtflg
 move q3,[point 8,mappag*1000] 
setzm prepag
setom mapflg
jrst ptchr1]
move q3,mapptr
ptchr1:setz q4,
ptchr2:skipg q2
 jrst [movem q3,mapptr 
retskp]
addi rchr,1
subi q2,1
ildb t2,q1
camn t2,rquote
 jrst [subi q2,1
addi q4,1
ildb t2,q1
move t1,t2
andi t1,^o177
camn t1,rquote
 jrst .+1
xori t2,^o100
jrst .+1]
idpb t2,q3
skipn ebtflg
 caige t2,^o200
 skipa
 jrst [move t3,rchr
idivi t3,5
skipn t4
 jrst [move t4,(q3) 
iori t4,1 
movem t4,(q3)
jrst .+1]
jrst .+1]
movei t1,<mappag+1>*1000 
caig t1,(q3)
 jrst [movem t2,tmp
movx t1,<.fhslf,,mappag> 
hrl t2,filjfn 
hrr t2,prepag
movx t3,pm%rd!pm%wr 
PMAP%
  %jsker (Unable to map out file page,r) 
move t1,prepag
addi t1,1
movem t1,prepag 
move q3,[point 7,mappag*1000]
skipe ebtflg
 move q3,[point 8,mappag*1000] 
move t2,tmp
idpb t2,q3
jrst .+1]
jrst ptchr2
gtnfil:move t1,ndxjfn
GNJFN%
 ret
hrrm t1,ndxjfn
hrrm t1,filjfn
retskp
gofil:saveac <q1>
move q1,t1
skipe t1,filjfn
 retskp
skipg t2
 jrst [kermsg <MDNSFN>
ret]
move t1,q1
call filfix
movx t1,gj%sht!gj%fou
GTJFN%
 %jsker (Unable to get a JFN on the file,r)
retskp
filfix:move t3,[point 7,filbuf]
filfx2:ildb t2,t1
skipn t2
 jrst [idpb t2,t3
move t2,[point 7,filbuf] 
ret]
caile t2," "
 cain t2,^o177
  jrst filfx2
cain t2,"."
 jrst filfx4
cail t2,"0"
 caile t2,"z"
  jrst filfx3
caige t2,"a"
 caig t2,"9"
  jrst filfx4
cail t2,"A"
 caile t2,"Z"
  jrst filfx3
jrst filfx4
filfx3:movei t4,^o26
idpb t4,t3
filfx4:idpb t2,t3
jrst filfx2
inilin:move t1,netjfn
RFMOD%
 %jserr (,r)
movem t2,oldmod
movx t2,tt%mff+tt%tab+tt%lca+tt%dum+tt%pgm 

SFMOD%
 %jserr (,.+1)
STPAR%
 %jserr (,.+1)
ret
reslin:move t1,netjfn
move t2,oldmod
SFMOD%
 %jserr (,.+1)
STPAR%
 %jserr (,.+1)
ret
spack:saveac <q1,q2,q3>
setz q2,
move q1,[point 8,sndpkt] 
move q3,sthdr
idpb q3,q1
move q3,spsiz
caml t3,[-3]
 caile t3,-5(q3)
  jrst [ermsg <Invalid data field of message>
ret]
move q3,t3
addi stot,5(t3)
addi q3," "+3
idpb q3,q1
add q2,q3
skipl t2
 cail t2,^o100
  jrst [ermsg <Invalid message sequence number>
ret]
addi t2," "
idpb t2,q1
add q2,t2
cail t1,"A"
 caile t1,"Z"
  jrst [ermsg <Illegal message type>
ret]
idpb t1,q1
add q2,t1
skipg t3
 jrst spack3
spack2:ildb t2,t4
idpb t2,q1
add q2,t2
subi t3,1
skiple t3
 jrst spack2
spack3:move t3,q2
andi q2,^o300
lsh q2,-6
add q2,t3
ldb t2,[point 6,q2,35] 
addi t2," "
idpb t2,q1
move t2,seolch
idpb t2,q1
setz t2,
idpb t2,q1
move t1,netjfn
move t2,[point 8,sndpkt] 
setzb t3,t4
SOUT%
 %jserr (Unable to output to the micro,r)
retskp
rpack:saveac <q1,q2,q3>
stkvar <type,num>
call timeit
move t1,netjfn
rpack0:BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
came t2,sthdr
 jrst rpack0
rpack1:move q1,[point 8,recpkt] 
idpb t2,q1
BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
camn t2,sthdr
 jrst rpack1
idpb t2,q1
move q2,t2
subi t2," "+3
skipge t2
 jrst [ermsg <Bad character count
>
jrst rperr]
move t3,t2
BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
camn t2,sthdr
 jrst rpack1
idpb t2,q1
add q2,t2
subi t2," "
movem t2,num
BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
camn t2,sthdr
 jrst rpack1
idpb t2,q1
add q2,t2
movem t2,type
move q3,t3
move t4,q1
skipg q3
 jrst rpack3
rpack2:BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
camn t2,sthdr
 jrst rpack1
idpb t2,q1
add q2,t2
subi q3,1
skiple q3
 jrst rpack2
rpack3:BIN%
 %jserr(Error inputing character from micro,rperr)
addi rtot,1
camn t2,sthdr
 jrst rpack1
setz t1,
idpb t1,q1
move q3,q2
andi q2,^o300
lsh q2,-6
add q2,q3
ldb q2,[point 6,q2,35] 
subi t2," "
came t2,q2
 jrst rperr
call timoff
move t1,netjfn
CFIBF%
 erjmp .+1
move t1,type
move t2,num
retskp
rperr:call timoff
move t1,netjfn
CFIBF%
 erjmp .+1
ret
pinit:movei t1,.FHSLF
move t2,[levtab,,chntab] 
SIR%
EIR%
ret
timeit:movei t1,.FHSLF
movx t2,1b0
AIC%
move t1,[.fhslf,,.timel] 
move t2,stimou
imuli t2,^d1000
setz t3,
TIMER%
 jrst [kermsg <UTSTI>
ret]
pop p,t1
movem p,intstk
push p,t1
hrri t1,tmout
movem t1,intpc
ret
timoff:saveac <t1,t2>
move t1,[.fhslf,,.timbf]
move t2,[377777,,-1]
timer%
 jrst .+1
movx t1,.FHSLF
movx t2,1b0
DIC%
ret
tmtrp:push p,t1
move t1,intpc
movem t1,pc1
pop p,t1
move p,intstk
DEBRK%
tmout:movei t1,"T"
move t2,pktnum
setzb t3,t4
retskp
subbp:saveac<q1,q2,q3,q4>
ldb q1,[point 6,t1,11] 
ldb q2,[point 6,t2,11] 
came q1,q2
 ret
movei q2,@t1
movei q4,@t2
sub q4,q2
movei q2,^d36
idiv q2,q1
imul q4,q2
move q2,q4
ldb q3,[point 6,t2,5] 
ldb t3,[point 6,t1,5] 
sub t3,q3
idiv t3,q1
add t3,q2
retskp
$ccn==2
ccon:movei t1,.fhslf
RPCAP%
movem t3,capas
movei t1,$ccn 
movem t1,ccn
move t1,p
sub t1,[1,,1]
movem t1,psave
movx t1,.fhslf
movx t2,1b1
AIC%
move t1,[.ticcc,,1]
ATI%
retskp
ccoff:setzm ccn
movx t1,.fhslf
movx t2,1b1
DIC%
RTIW%
tlz t2,040000
STIW%
move t3,capas
EPCAP%
 erjmp .+1
ret
cctrap:sosle ccn
 DEBRK%
move t1,[1b5+reslin]
movem t1,pc1
hrroi t1,[asciz/^C
/]
PSOUT%
move p,psave
setom f$exit
DEBRK%
LevTab:pc1
pc2
pc3
chnTab:1,,tmtrp
1,,cctrap
repeat <^d34>,<0>
pdl:block 100
pc1:0
pc2:0
pc3:0
intpc:z
intstk:z
ccn:z
psave:z
capas:z
pars3:z
f$exit:z
filjfn:z
ndxjfn:z
diajfn:z
netjfn:z
oldmod:z
ttynum:z
errptr:z
ebtflg:0
igpar:0
mapflg:0
mapptr:z
filpag:z
filbyt:z
filbsz:z
prepag:z
stdat:z
size:z
spsiz:136
rpsiz:136
stimou:12
rtimou:10
spadch:0
rpadch:0
spadnm:0
rpadnm:0
seolch:15
reolch:15
squote:"#"
rquote:"#"
delay:5
sthdr:1
rtchr:z
stchr:z
numtry:z
oldtry:z
maxtry:5
imxtry:20
pktnum:z
eoflag:z
filbuf:block ^d20
buffer:block maxpkt/4
data:block maxpkt/4
sndpkt:byte (7) 1,0
block maxpkt/4
recpkt:byte (7) 1,0
block maxpkt/4
%%krbf:asciz/                                                                                /
end start