XMLSWP ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:58
;;8.0;MailMan;**45**;Jun 28, 2002;Build 8
SEND ;
S X=1 G I^XMLSWP0
1 ;I $L(XMSG)>245 G E
I XMSG'?.ANP F %=1:1:$L(XMSG) I $E(XMSG,%)?1C,$A(XMSG,%)'=9 S XMSG=$E(XMSG,1,%-1)_$E(XMSG,%+1,999) Q:XMSG?.ANP S %=%-1
S C=C+$L(XMSG),F=0 I G S A=A+1,XMLIN=$S(J<1:"",1:XMLIN\1+1),(M,B(1))=0,XMLCT=$S($D(XMLCT):XMLCT+$L(XMSG),1:$L(XMSG))
D S I=$S('G:"",1:XMLIN),X=XMSG D SUM S Q=I_U_S_"^~^^"_$S(XMSG=".":"<<END~OF~FILE>>",1:"") D CHK S $P(Q,U,4)=S
W X_$C(13),Q_$C(13) S D=X X P("S")
I G,I'="" S W(I,0)=J,W(I,1)=$P(Q,U,2),W(I,2)=Q
I $D(XMINST),$L(XMINST),$S(I<100&(I#20=0):1,I#100=0:1,I<1:1,B(1):1,'J:1,1:0) D PROGS^XMLSWP2
;
C G Q:$S(ER:1,1:0) I G,$D(XMLIN),XMLIN G W
2 I G,XMLIN,'$O(W(0)) G Q:J<1!'J,W
R X:$S('$D(XMLIN):30,XMLIN="":30,'G:30,W<8:9,1:5) E S:M M=2 G U:'$L(X)
I X'?.".".N1"^"1N.N1"^~".E G:'G 1:X="!@~^NAK^~@!",C S G=G+1 G C:G<3,W
S D=X,$P(X,U,4)="" D SUM S X=D I S'=$P(X,U,4) G G:G S F=F+1 G 2:F<9,QQQ
S B=0 I X?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch" S D=X,B=0 X P("R") S Y=X G G2
I $S('$D(XMLIN):1,XMLIN="":1,'G:1,1:0) G Q:X=Q S F=F+1 G 2:F<9,QQQ
3 I '$D(W(+X)) G G9:M="END",W
I W(+X,1)-$P(X,U,2)'=0 S D="BAD Acknowledgement" X P("I") G R
I $O(W(0))=+X D K S G=1 G G9:M="END",W:'M,C
I $D(W(+X)) D K S G=G+1 S:W<G W=$S(W-4>6:W-4,W>6:6,1:W),V=0 G G:W<G I W*2<G S G=1 G R
I $O(W(0)) S G=G+1 G G9:M="END",G:'M,C:M=1 I W*2<G S G=1 G G
W I $S(W<5&(W*2<A):1,W/2+W<A:1,1:0) G 2
I $D(Z),$P(Z,U)="@" G G9:Z="@^1" S M=0,Z=Z_"^1" G G9
S J=$O(^XMB(3.9,XMZ,2,J)) I J S XMSG=^(J,0) G 1:$E(XMSG)'="." S XMSG="."_XMSG G 1
S Z="@" G C
E D E^XMLSWP0
QQQ G QQQ^XMLSWP2
QQ G QQ^XMLSWP2
Q G Q^XMLSWP2
R G R^XMLSWP2
;ACK
K S V=V+1 I $D(W(+X)) S A=A-1 K W(+X)
Q:$S(W<5&(W*2>V):1,W>4&(W*3>V):1,1:0)
S V=0 I $D(IOST),$E(IOST,1,6)="C-MINI" S W=$S(W<8:8,W<9:10,W<12:12,1:W)
E S W=$S(W<4:4,1:5)
Q
;Timeout
U S B(1)=B(1)+1,D="Time-out ["_B(1)_"]" X P("I") I B(1)<$S(G:4,1:2) G:'$O(W(0)) W:G,D S I=XMLIN G R:A>W,W:G,D
G E
CHK N X S X=Q
SUM ;Calculate S=checksum
I $D(XMOS(0)) X XMOS(0) S S=XMSUM Q
I XMOS["VAX DSM" X "S S=$ZC(%LPC,X)+$L(X)*$L(X)" Q
I XMOS["DSM" X "S S=$ZC(LPC,X)+$L(X)*$L(X)" Q
I XMOS["M/11"!(XMOS["M/VX") X "S S=$ZC(X)+$L(X)*$L(X)" Q
G ZSUM^XMLSWP0
;RE-SYNCH Sender
G S (B,XMLSWPQ,M)=0 I M,'$O(W(0)) G W
I M'=1 G W:'$O(W(0)) S M=1 G 2
G0 S XMLSWPQ=$G(XMLSWPQ)+1 R Y:(9+B) G:'$T G9:XMLSWPQ>20,G0 K XMLSWPQ I B>$S(M:3,1:33) G Q:'M,E
G G9:'$L(Y) S D=Y X P("R") I Y="A-OK" R Y:(9+B) G G9:Y="",G9:Y'="^432^~" F D=0:0 R Y:4 E G R:$O(W(0)),QQ
G G1:Y?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch" I 'M S M=0 G G9:'$O(W(0)) S X=Y,M="END" G 3
G W:Y=O,G9
G1 S (D,X)=Y,$P(X,U,4)="" D SUM G G9:S'=$P(D,U,4)
G2 S D="Rec'r reqests "_$P(Y,U,2) X P("I") S B=0 G R:$O(W(0)),QQQ
G9 S (D,X)=O,B=B+1 D SUM S X=U_S_"^~^^@@<<Ctrl-Packet>>" D SUM S $P(X,U,4)=S W O_$C(13)_X_$C(13) X P("S")
G G0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMLSWP 2913 printed Oct 16, 2024@18:13:19 Page 2
XMLSWP ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:58
+1 ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8
SEND ;
+1 SET X=1
GOTO I^XMLSWP0
1 ;I $L(XMSG)>245 G E
+1 IF XMSG'?.ANP
FOR %=1:1:$LENGTH(XMSG)
IF $EXTRACT(XMSG,%)?1C
IF $ASCII(XMSG,%)'=9
SET XMSG=$EXTRACT(XMSG,1,%-1)_$EXTRACT(XMSG,%+1,999)
if XMSG?.ANP
QUIT
SET %=%-1
+2 SET C=C+$LENGTH(XMSG)
SET F=0
IF G
SET A=A+1
SET XMLIN=$SELECT(J<1:"",1:XMLIN\1+1)
SET (M,B(1))=0
SET XMLCT=$SELECT($DATA(XMLCT):XMLCT+$LENGTH(XMSG),1:$LENGTH(XMSG))
D SET I=$SELECT('G:"",1:XMLIN)
SET X=XMSG
DO SUM
SET Q=I_U_S_"^~^^"_$SELECT(XMSG=".":"<<END~OF~FILE>>",1:"")
DO CHK
SET $PIECE(Q,U,4)=S
+1 WRITE X_$CHAR(13),Q_$CHAR(13)
SET D=X
XECUTE P("S")
+2 IF G
IF I'=""
SET W(I,0)=J
SET W(I,1)=$PIECE(Q,U,2)
SET W(I,2)=Q
+3 IF $DATA(XMINST)
IF $LENGTH(XMINST)
IF $SELECT(I<100&(I#20=0):1,I#100=0:1,I<1:1,B(1):1,'J:1,1:0)
DO PROGS^XMLSWP2
+4 ;
C if $SELECT(ER:1,1:0)
GOTO Q
IF G
IF $DATA(XMLIN)
IF XMLIN
GOTO W
2 IF G
IF XMLIN
IF '$ORDER(W(0))
if J<1!'J
GOTO Q
GOTO W
+1 READ X:$SELECT('$DATA(XMLIN):30,XMLIN="":30,'G:30,W<8:9,1:5)
IF '$TEST
if M
SET M=2
if '$LENGTH(X)
GOTO U
+2 IF X'?.".".N1"^"1N.N1"^~".E
if 'G
if X="!@~^NAK^~@!"
GOTO 1
GOTO C
SET G=G+1
if G<3
GOTO C
GOTO W
+3 SET D=X
SET $PIECE(X,U,4)=""
DO SUM
SET X=D
IF S'=$PIECE(X,U,4)
if G
GOTO G
SET F=F+1
if F<9
GOTO 2
GOTO QQQ
+4 SET B=0
IF X?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch"
SET D=X
SET B=0
XECUTE P("R")
SET Y=X
GOTO G2
+5 IF $SELECT('$DATA(XMLIN):1,XMLIN="":1,'G:1,1:0)
if X=Q
GOTO Q
SET F=F+1
if F<9
GOTO 2
GOTO QQQ
3 IF '$DATA(W(+X))
if M="END"
GOTO G9
GOTO W
+1 IF W(+X,1)-$PIECE(X,U,2)'=0
SET D="BAD Acknowledgement"
XECUTE P("I")
GOTO R
+2 IF $ORDER(W(0))=+X
DO K
SET G=1
if M="END"
GOTO G9
if 'M
GOTO W
GOTO C
+3 IF $DATA(W(+X))
DO K
SET G=G+1
if W<G
SET W=$SELECT(W-4>6:W-4,W>6:6,1:W)
SET V=0
if W<G
GOTO G
IF W*2<G
SET G=1
GOTO R
+4 IF $ORDER(W(0))
SET G=G+1
if M="END"
GOTO G9
if 'M
GOTO G
if M=1
GOTO C
IF W*2<G
SET G=1
GOTO G
W IF $SELECT(W<5&(W*2<A):1,W/2+W<A:1,1:0)
GOTO 2
+1 IF $DATA(Z)
IF $PIECE(Z,U)="@"
if Z="@^1"
GOTO G9
SET M=0
SET Z=Z_"^1"
GOTO G9
+2 SET J=$ORDER(^XMB(3.9,XMZ,2,J))
IF J
SET XMSG=^(J,0)
if $EXTRACT(XMSG)'="."
GOTO 1
SET XMSG="."_XMSG
GOTO 1
+3 SET Z="@"
GOTO C
E DO E^XMLSWP0
QQQ GOTO QQQ^XMLSWP2
QQ GOTO QQ^XMLSWP2
Q GOTO Q^XMLSWP2
R GOTO R^XMLSWP2
+1 ;ACK
K SET V=V+1
IF $DATA(W(+X))
SET A=A-1
KILL W(+X)
+1 if $SELECT(W<5&(W*2>V)
QUIT
+2 SET V=0
IF $DATA(IOST)
IF $EXTRACT(IOST,1,6)="C-MINI"
SET W=$SELECT(W<8:8,W<9:10,W<12:12,1:W)
+3 IF '$TEST
SET W=$SELECT(W<4:4,1:5)
+4 QUIT
+5 ;Timeout
U SET B(1)=B(1)+1
SET D="Time-out ["_B(1)_"]"
XECUTE P("I")
IF B(1)<$SELECT(G:4,1:2)
if '$ORDER(W(0))
if G
GOTO W
GOTO D
SET I=XMLIN
if A>W
GOTO R
if G
GOTO W
GOTO D
+1 GOTO E
CHK NEW X
SET X=Q
SUM ;Calculate S=checksum
+1 IF $DATA(XMOS(0))
XECUTE XMOS(0)
SET S=XMSUM
QUIT
+2 IF XMOS["VAX DSM"
XECUTE "S S=$ZC(%LPC,X)+$L(X)*$L(X)"
QUIT
+3 IF XMOS["DSM"
XECUTE "S S=$ZC(LPC,X)+$L(X)*$L(X)"
QUIT
+4 IF XMOS["M/11"!(XMOS["M/VX")
XECUTE "S S=$ZC(X)+$L(X)*$L(X)"
QUIT
+5 GOTO ZSUM^XMLSWP0
+6 ;RE-SYNCH Sender
G SET (B,XMLSWPQ,M)=0
IF M
IF '$ORDER(W(0))
GOTO W
+1 IF M'=1
if '$ORDER(W(0))
GOTO W
SET M=1
GOTO 2
G0 SET XMLSWPQ=$GET(XMLSWPQ)+1
READ Y:(9+B)
if '$TEST
if XMLSWPQ>20
GOTO G9
GOTO G0
KILL XMLSWPQ
IF B>$SELECT(M:3,1:33)
if 'M
GOTO Q
GOTO E
+1 if '$LENGTH(Y)
GOTO G9
SET D=Y
XECUTE P("R")
IF Y="A-OK"
READ Y:(9+B)
if Y=""
GOTO G9
if Y'="^432^~"
GOTO G9
FOR D=0:0
READ Y:4
IF '$TEST
if $ORDER(W(0))
GOTO R
GOTO QQ
+2 if Y?1"!@~^"1N.N1"^~@!^"1N.N1"^Resynch"
GOTO G1
IF 'M
SET M=0
if '$ORDER(W(0))
GOTO G9
SET X=Y
SET M="END"
GOTO 3
+3 if Y=O
GOTO W
GOTO G9
G1 SET (D,X)=Y
SET $PIECE(X,U,4)=""
DO SUM
if S'=$PIECE(D,U,4)
GOTO G9
G2 SET D="Rec'r reqests "_$PIECE(Y,U,2)
XECUTE P("I")
SET B=0
if $ORDER(W(0))
GOTO R
GOTO QQQ
G9 SET (D,X)=O
SET B=B+1
DO SUM
SET X=U_S_"^~^^@@<<Ctrl-Packet>>"
DO SUM
SET $PIECE(X,U,4)=S
WRITE O_$CHAR(13)_X_$CHAR(13)
XECUTE P("S")
+1 GOTO G0
