- XMLSWP0 ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:59
- ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8
- REC ;SEE SEND
- S X=0 G I
- RL ;
- R X:$S($D(XMSTIME):XMSTIME,1:15) S Z=$T,(XMRG,D)=X X P("R")
- I 'Z S B=B+1 G RL:B<3 S B=0,B(0)=$S($D(B(0)):B(0)+1,1:1) G:B(0)<4&G F:'M,RL D E G ER
- S (B,B(0))=0
- Y S L=X D SUM I $D(XMLIN),XMLIN>1,X?1"..".E S (XMRG,X)=$E(X,2,999)
- R W:15 E S B=B+1 G RL
- G Z:L'=".",Z:$P(W,U,2)'=47,Z:$P(W,U,5)'="<<END~OF~FILE>>"
- S (D,V)=1,F=0 I $O(W(0)) G F
- V S XMRG="." K XMBLOCK F XMLIN=XMLIN+1:1 Q:'$D(^XMB(3.9,XMZ,2,XMLIN))
- D SEND Q:D S F=F+1 G ER
- Z S D=0 I W'?.".".N1"^"1N.N1"^~".E S (XMRG,X)=W G Y
- I S-$P(W,U,2)=0 S D=1 D SEND
- I D,L=O G F:$P(W,"@@",2)="<<Ctrl-Packet>>"
- I 'D G F:G S F=F+1,ER=1 Q:F>3 W "!@~^NAK^~@!",$C(13) S ER=0 G RL
- Q:'$D(XMLIN)!'+W Q:XMLIN=0 S M=$S(L="QUIT":99,1:0),F=0
- I XMLIN>1,XMLIN+1-W'=0,W-XMLIN>0 F D=W-1:-1 Q:D<1!$D(^XMB(3.9,XMZ,2,D,0)) S W(D)=""
- S D=$S(1-W>0:XMLIN+.001,1:+W) S:D-XMLIN>0 XMLIN=+W K W(+W) I '$D(^XMB(3.9,XMZ,2,D,0)) S ^(0)=XMRG,C=C+$L(XMRG)
- I $D(XMINST),$L(XMINST) S I=XMLIN D P
- G W:XMLIN#10'=0,W:'$O(W(0)) D E S D="Didn't receive "_$O(W(0)) X P("I")
- G F
- W G RL:'V,F:$O(W(0)),V
- ;
- ;QUIT control
- E S F=F+1 S D="Errors ("_F_")" X P("I") Q
- 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
- ZSUM S S=$A(X) Q:$L(X)=1 N J S J=1
- A S J=J+1 I $L(X)<J K %,%0,%1 S S=S+$L(X)*$L(X) Q
- S Y=$A(X,J) F %=256:0 Q:%\4<Y S %=%\2
- B S %0=S#%,%=%\2 G A:%=0 S %0=%0\%,%1=Y\% I %1=1 S Y=Y-%
- G B:%1+%0=0 I %1'=%0 S:%0=0 S=S+% G B
- G B:%0=0 S S=S-%
- G B
- P N G S G=1,XMLCT=$S($D(XMLCT):XMLCT+$L(XMRG),1:$L(XMRG)) Q:$S(XMLIN<100&(XMLIN#20'=0):1,XMLIN#100'=0:1,1:0) G PROGR^XMLSWP2
- I ;Initialize
- N %,A,B,C,D,E,F,G,I,L,M,O,P,Q,S,T,Y,Z
- I $D(XMS0AJ),XMS0AJ<1 N J S (XMLIN,J)=XMS0AJ
- F I=73,83,82 S P($C(I))="I $D(XMLD) S XMTRAN="_$C(34,I,58,32,34)_"_$E(D,1,240) D TRAN^XMLSWP2"
- K Z,W,M S ER=0,(A,B,B(0),B(1),C,E,F,G,M,Q,V)=0,(I,L)="",O="!@~^Resynch^~@!1545",W=$S($E(IOST,1,6)="C-MINI":2,1:1)*3,T=$H*86400+$P($H,",",2)-1
- I $D(XMBLOCK) G ER:'$D(XMS0AJ) S G=1,XMLIN=$S('$D(XMLIN):0,1:XMLIN),J=XMS0AJ G ER:XMTLER
- D LPC:'$D(XMOS) G 1^XMLSWP:X,RL
- ;
- ;RE-SYNCH Receiver
- F I '$O(W(0)) W "A-OK"_$C(13)_"^432^~"_$C(13) G RL
- S (B(0),B)=0,M=50
- S (D,X)="!@~^"_+$O(W(0))_"^~@!^^Resynch" D SUM S $P(D,U,4)=S W D,$C(13) X P("S")
- G RL
- ER S ER=1 Q
- SEND S X=W,$P(X,U,4)="" D SUM I S=$P(W,U,4) Q:$P(W,"@@",2)="<<Ctrl-Packet>>" W W_$C(13) Q
- S D=0 Q
- LPC ;GET CORRECT LPC checksum information
- S XMOS=$S($D(^%ZOSF("OS")):^("OS"),1:0) I $D(^("LPC")) S XMOS(0)=^("LPC")
- I '$D(XMOS(0)),$D(^XMB(1,1,"LPC")) S XMOS(0)=^("LPC")
- I $D(XMOS(0)) S XMOS(0)=XMOS(0)_",XMSUM=Y+$L(X)*$L(X)"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMLSWP0 2868 printed Jan 18, 2025@03:13:38 Page 2
- XMLSWP0 ;(WASH ISC)/CAP-Sliding Window Protocol ;04/17/2002 10:59
- +1 ;;8.0;MailMan;**45**;Jun 28, 2002;Build 8
- REC ;SEE SEND
- +1 SET X=0
- GOTO I
- RL ;
- +1 READ X:$SELECT($DATA(XMSTIME):XMSTIME,1:15)
- SET Z=$TEST
- SET (XMRG,D)=X
- XECUTE P("R")
- +2 IF 'Z
- SET B=B+1
- if B<3
- GOTO RL
- SET B=0
- SET B(0)=$SELECT($DATA(B(0)):B(0)+1,1:1)
- if B(0)<4&G
- if 'M
- GOTO F
- GOTO RL
- DO E
- GOTO ER
- +3 SET (B,B(0))=0
- Y SET L=X
- DO SUM
- IF $DATA(XMLIN)
- IF XMLIN>1
- IF X?1"..".E
- SET (XMRG,X)=$EXTRACT(X,2,999)
- +1 READ W:15
- IF '$TEST
- SET B=B+1
- GOTO RL
- +2 if L'="."
- GOTO Z
- if $PIECE(W,U,2)'=47
- GOTO Z
- if $PIECE(W,U,5)'="<<END~OF~FILE>>"
- GOTO Z
- +3 SET (D,V)=1
- SET F=0
- IF $ORDER(W(0))
- GOTO F
- V SET XMRG="."
- KILL XMBLOCK
- FOR XMLIN=XMLIN+1:1
- if '$DATA(^XMB(3.9,XMZ,2,XMLIN))
- QUIT
- +1 DO SEND
- if D
- QUIT
- SET F=F+1
- GOTO ER
- Z SET D=0
- IF W'?.".".N1"^"1N.N1"^~".E
- SET (XMRG,X)=W
- GOTO Y
- +1 IF S-$PIECE(W,U,2)=0
- SET D=1
- DO SEND
- +2 IF D
- IF L=O
- if $PIECE(W,"@@",2)="<<Ctrl-Packet>>"
- GOTO F
- +3 IF 'D
- if G
- GOTO F
- SET F=F+1
- SET ER=1
- if F>3
- QUIT
- WRITE "!@~^NAK^~@!",$CHAR(13)
- SET ER=0
- GOTO RL
- +4 if '$DATA(XMLIN)!'+W
- QUIT
- if XMLIN=0
- QUIT
- SET M=$SELECT(L="QUIT":99,1:0)
- SET F=0
- +5 IF XMLIN>1
- IF XMLIN+1-W'=0
- IF W-XMLIN>0
- FOR D=W-1:-1
- if D<1!$DATA(^XMB(3.9,XMZ,2,D,0))
- QUIT
- SET W(D)=""
- +6 SET D=$SELECT(1-W>0:XMLIN+.001,1:+W)
- if D-XMLIN>0
- SET XMLIN=+W
- KILL W(+W)
- IF '$DATA(^XMB(3.9,XMZ,2,D,0))
- SET ^(0)=XMRG
- SET C=C+$LENGTH(XMRG)
- +7 IF $DATA(XMINST)
- IF $LENGTH(XMINST)
- SET I=XMLIN
- DO P
- +8 if XMLIN#10'=0
- GOTO W
- if '$ORDER(W(0))
- GOTO W
- DO E
- SET D="Didn't receive "_$ORDER(W(0))
- XECUTE P("I")
- +9 GOTO F
- W if 'V
- GOTO RL
- if $ORDER(W(0))
- GOTO F
- GOTO V
- +1 ;
- +2 ;QUIT control
- E SET F=F+1
- SET D="Errors ("_F_")"
- XECUTE P("I")
- QUIT
- +1 QUIT
- 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
- ZSUM SET S=$ASCII(X)
- if $LENGTH(X)=1
- QUIT
- NEW J
- SET J=1
- A SET J=J+1
- IF $LENGTH(X)<J
- KILL %,%0,%1
- SET S=S+$LENGTH(X)*$LENGTH(X)
- QUIT
- +1 SET Y=$ASCII(X,J)
- FOR %=256:0
- if %\4<Y
- QUIT
- SET %=%\2
- B SET %0=S#%
- SET %=%\2
- if %=0
- GOTO A
- SET %0=%0\%
- SET %1=Y\%
- IF %1=1
- SET Y=Y-%
- +1 if %1+%0=0
- GOTO B
- IF %1'=%0
- if %0=0
- SET S=S+%
- GOTO B
- +2 if %0=0
- GOTO B
- SET S=S-%
- +3 GOTO B
- P NEW G
- SET G=1
- SET XMLCT=$SELECT($DATA(XMLCT):XMLCT+$LENGTH(XMRG),1:$LENGTH(XMRG))
- if $SELECT(XMLIN<100&(XMLIN#20'=0)
- QUIT
- GOTO PROGR^XMLSWP2
- I ;Initialize
- +1 NEW %,A,B,C,D,E,F,G,I,L,M,O,P,Q,S,T,Y,Z
- +2 IF $DATA(XMS0AJ)
- IF XMS0AJ<1
- NEW J
- SET (XMLIN,J)=XMS0AJ
- +3 FOR I=73,83,82
- SET P($CHAR(I))="I $D(XMLD) S XMTRAN="_$CHAR(34,I,58,32,34)_"_$E(D,1,240) D TRAN^XMLSWP2"
- +4 KILL Z,W,M
- SET ER=0
- SET (A,B,B(0),B(1),C,E,F,G,M,Q,V)=0
- SET (I,L)=""
- SET O="!@~^Resynch^~@!1545"
- SET W=$SELECT($EXTRACT(IOST,1,6)="C-MINI":2,1:1)*3
- SET T=$HOROLOG*86400+$PIECE($HOROLOG,",",2)-1
- +5 IF $DATA(XMBLOCK)
- if '$DATA(XMS0AJ)
- GOTO ER
- SET G=1
- SET XMLIN=$SELECT('$DATA(XMLIN):0,1:XMLIN)
- SET J=XMS0AJ
- if XMTLER
- GOTO ER
- +6 if '$DATA(XMOS)
- DO LPC
- if X
- GOTO 1^XMLSWP
- GOTO RL
- +7 ;
- +8 ;RE-SYNCH Receiver
- F IF '$ORDER(W(0))
- WRITE "A-OK"_$CHAR(13)_"^432^~"_$CHAR(13)
- GOTO RL
- +1 SET (B(0),B)=0
- SET M=50
- +2 SET (D,X)="!@~^"_+$ORDER(W(0))_"^~@!^^Resynch"
- DO SUM
- SET $PIECE(D,U,4)=S
- WRITE D,$CHAR(13)
- XECUTE P("S")
- +3 GOTO RL
- ER SET ER=1
- QUIT
- SEND SET X=W
- SET $PIECE(X,U,4)=""
- DO SUM
- IF S=$PIECE(W,U,4)
- if $PIECE(W,"@@",2)="<<Ctrl-Packet>>"
- QUIT
- WRITE W_$CHAR(13)
- QUIT
- +1 SET D=0
- QUIT
- LPC ;GET CORRECT LPC checksum information
- +1 SET XMOS=$SELECT($DATA(^%ZOSF("OS")):^("OS"),1:0)
- IF $DATA(^("LPC"))
- SET XMOS(0)=^("LPC")
- +2 IF '$DATA(XMOS(0))
- IF $DATA(^XMB(1,1,"LPC"))
- SET XMOS(0)=^("LPC")
- +3 IF $DATA(XMOS(0))
- SET XMOS(0)=XMOS(0)_",XMSUM=Y+$L(X)*$L(X)"
- +4 QUIT