Listing of file='KFAMClos' on disk='vmedia/701-2606C.wvd.zip'
# Sector 5, program filename = 'KFAMClos'
0010 REM KFAMClos, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 COM V7$(Q)8,V0$(Q)14,T5$(Q)58
: COM T0$16,V7$16,V8,T8,V3$2,V2$2,Q3$2,Q2$2,V8$1,V6$1
: COM Q2,Q3,Q$1,T6$1,T0,T2$2,T8$1,T$(3)48,T3$3,T7$30,V,T2
: COM V7,Q,V1,V4$4,S2,V6,T1,V0$2,T$8,T2$(8)2,T9,T1$30,T9$2
: COM V0,T6,T4$3,T0$(4)60,T4,T3,T5,V9$2,T
0199 GOSUB '99
0579 $BREAK1
0580 IF @T=0THEN @T=S2
: ELSE GOTO 579
: RETURN
0590 @T=0
: RETURN
0726 SELECT @PARTS$
: IF T9>0AND T6=T9THEN 750
: IF V0$(T6)=" "THEN 2908
: GOSUB 858
: T9=T6
: $UNPACK(F=@Q8$)V0$(T9)TO V0$,V6,V4$,V0,T2,T4,T5,V7,V1
: SELECT #T1<V4$>
: $UNPACK(F=@T5$)T5$(T9)TO T4$,T7$,T8$,T$,T2$()
: V4$=HEX(A0)&BIN(T4)&HEX(A003)
: GOSUB 818
: T9$=HEX(FF)
0750 $CLOSE#T1,#T2
: IF MOD(V0,2)=0THEN 812
: Q$=BIN(V6)
: Q2$=BIN(S2)&Q$
: MAT SEARCH@V4$(),=STR(Q2$)TO V9$STEP 5
: T=VAL(V9$,2)
: IF T>0THEN STR(@V4$(),T,5)=ALL(FF)
: GOSUB 580
: STR(@Q$,@Q)=STR(Q2$,,1)
: STR(@Q9$,@Q)=Q$
: STR(@Q0$,@Q*3-2)=STR(@T$(V6),4,3)
: @Q=@Q+1
0784 MAT SEARCH@Q0$,=STR(@T$(V6),4,3)TO V7$STEP 3
: IF VAL(STR(@Q$,(VAL(V7$,2)+2)/3))=S2THEN 794
: @T=0
: $BREAK1
: GOSUB 580
: GOTO 784
0794 @T=0
: HEXUNPACKSTR(@T$(V6),10)TO V7$
: T8$=STR(V7$,S2)
: HEXPACKQ$FROMT8$
: Q$=AND HEX(60)
: IF Q$>HEX(20)THEN GOSUB 818
: Q$=AND HEX(20)
: IF Q$=HEX(20)THEN T6$=BIN(0)
0812 IF V>4AND VAL(T6$)<>T9THEN 873
: RETURN
0818 $UNPACK(F=@V$)STR(@T$(V6),7)TO T0,T2$
: RETURN
0824 HEXUNPACKSTR(@T$(V6),10)TO V7$
: STR(V7$,S2,1)=T8$
: HEXPACKSTR(@T$(V6),10)FROMV7$
: RETURN
0858 IF T9>0THEN $PACK(F=@T5$)T5$(T9)FROMT4$,T7$,T8$,T$,T2$()
: RETURN
0873 DATA LOAD DA T#T1,(V0$)Q2,T$()
: T6$=BIN(T9)
: RETURN
0908 Q2$=BIN(S2)
: T=POS(@Q$=Q2$)
: STR(@Q9$,T)=STR(@Q9$,T+1)
: STR(@Q$,T)=STR(@Q$,T+1)
: STR(@Q0$,T*3-2)=STR(@Q0$,T*3+1)
: @Q=@Q-1
: GOTO 590
1435 SELECT @PARTS0$
: RETURN
2090 DIM R9$(16)
2384 DEFFN'239(T6)
: Q=0
: V=5
: IF T6>0THEN T3$="P"
: ELSE T3$="S"
: T6=ABS(T6)
: GOSUB 726
: T8$="F"
: DATA SAVE DA T$#T1,(V0$)0,T$()
: STR(T0$,T2+1,1)=" "
: IF V0>2AND T3$="P"THEN GOSUB 2445
: Q$=" "
: GOSUB '219(V7$(T9),T2,S2," ",0)
: SELECT @PARTS$
: V0$(T9)=" "
: T9=0
: GOSUB 580
: GOSUB 824
: IF POS(V7$<>"F")=0THEN @T$(V6)=ALL(FF)
: IF MOD(V0,2)=1THEN GOSUB 908
: ELSE GOSUB 590
: GOTO 1435
2445 T6=MOD(VAL(STR(T$(2),4),2)+VAL(STR(T$(2),12)),65536)
: DATA LOAD DC OPEN T#T2,V7$(T9)
: DSKIP #T2,T6S
: SELECT @PARTS0$
: GOSUB '218(V7$(T9),T2,V9$,0)
: LIMITS T#T2,V7$(T9),Q2,T,T3
: T=T-1
: T9$=HEX(FF)
: T0$()=HEX(A0FD)&T$()
: DATA SAVE BA T$#T2,(T)T0$()
: DATA LOAD DC OPEN T#T2,V7$(T9)
: RETURN
2626 IF T8=0THEN $CLOSE#Q3
: SELECT @PARTS0$
: RETURN
2632 DATA LOAD BA T#Q3,(Q7)R9$()
: RETURN
2638 DATA SAVE BA T#Q3,(Q7)R9$()
: RETURN
2690 DEFFN'219(V7$,Q3,S2,V9$,T8)
: $OPEN #Q3
: LIMITS T#Q3,V7$,Q6,Q7,Q8
: GOSUB 2632
: Q$,STR(R9$(),32+S2,1)=" "
: GOSUB 2638
: DATA SAVE DC CLOSE#Q3
: GOTO 2626
2908 RETURN CLEAR
2911 Q$="X"
: GOTO 1435
9998 DEFFN'29"Q$=";HEX(22);"KFAMClos";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)