- 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 Jan 18, 2025@03:13:37 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