Listing of file='FCST120A' on disk='vmedia/701-2663.wvd.zip'
# Sector 112, program filename = 'FCST120A'
0010 REM FCST120A, RELEASE 1-0, (07/31/79), THIS PROGRAM IS A COPYRIGHT PRODU
CT OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
SIMULATOR DATA ACCESS
0430 COM A6$(1)38,C0$20,F7$3,I9,K(44),K1,K2,K3,K9,K1$9,K2$9,K2$(2)1,K3$8,K5$30
,K9$4,M$8,I0$3
: COM A,A0,A0$1,A1,A1$1,A2,A3,A3$1,A4,A4$1,A5,B,B(13),B0,B1,B1(2,5),B2,B3,B
4,B5,C0,C1,C2,C3,C5,D,D0,D1,D2,D3,D4,D5,G,G1,G2
: COM Q3,Q4,Q5,Q6,Q7,Q8,Q9,Q$1,Q$(2)80,Q6$80,Q7$80
0480 GOTO 4000
3940 DEFFN'93(Q$(2))
: Q7$="ENTER PRINTER ADDRESS (215, 216, 204)"
: IF Q$="H"THEN STR(Q7$,LEN(Q7$))=", BLANK = NO PRINTER)"
: IF Q$(2)=" "THEN Q$(2)="MOUNT PAPER INTO PRINTER"
: IF I0$=" "THEN Q6$="215"
: ELSE Q6$=I0$
: GOSUB '100("215,216,204, ,005",Q$(2),3,2,Q7$,3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: I0$=Q6$
3948 IF I0$=" "THEN RETURN
: SELECT #15<Q6$>
: $OPEN 3963,#15
: ERRORPRINT AT(3,0,80);"Printer ";Q6$;" not attached to system.";HEX(07)
: GOTO 3940
3951 SELECT @PARTS$
: PACK(##)STR(@I0$,Q9,1)FROMS2
: SELECT @PARTS0$
: L,L0=56
3955 PRINT AT(1,0);Q$(2)
: IF I0$="204"THEN PRINT AT(3,0,80);HEX(07);"Make sure that terminal printe
r is on, and selected."
: GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: $GIO#15(010102001212400040004000,Q6$)
: IF STR(Q6$,8,1)=HEX(00)THEN RETURN
: PRINT AT(3,0,80);"Printer not ready. Turn printer on, and select.";HEX(07
)
: GOTO 3955
3963 SELECT @PARTS$
: PRINT AT(3,0,80);"Printer is being used by station ";HEXOF(STR(@I0$,Q9,1)
);HEX(072E)
: SELECT @PARTS0$
: Q$="H"
: GOTO 3940
4000 DIM R4$,R,R1,R2,R8,R9,J0,J$(8),R1$8,R9$8,R9$(16)
: DIM K0$62,I$(4)62,E6$3,K4$8,L8$5
: GOTO 5240
4040 GOSUB '100("1","2",1,0,"ENTER SOURCE OF DATA (1=KEYBOARD 2=SIMULATOR FILE
)",1)
: K2$="NEW"
: IF Q9=1THEN 4100
: K2$="SIMULATOR"
: PRINT AT(5,16,64);"1. DATA SOURCE = ";K2$
: RETURN
4100 RETURN CLEAR
4110 GOTO 5870
4140 Q6$=F7$
: GOSUB '100(" "," ",3,0,"ENTER DESIRED DISK ADDRESS",3)
: GOSUB 4490
: R9$=Q6$
: MAT SEARCH"310320330350360370B10B20B30B50B60B70D10D11D12D13D14D15D20D21D2
2D23D24D25D30D31D32D33D34D35D50D51D52D53D54D55D60D61D62D63D64D65D70D71D72
D73D74D75",=R9$TO Q7$STEP 3
4190 IF STR(Q7$,,2)<>HEX(0000)THEN 4230
: PRINT AT(3,0,80);HEX(07);"ADDRESS ";R9$;" IS INVALID"
: IF R9$=F7$THEN F7$=" "
: GOTO 4140
4230 F7$=R9$
: SELECT #2<F7$>
: PRINT AT(7,16,64);"3. DISK ADDRESS = ";F7$
: RETURN
4290 PRINT AT(3,0,80);HEX(07);"DISK ERROR";ERR;"HAS OCCURRED"
: CONVERT E7$TO Q9
: E7$=" "
: ON Q9GOTO 5600,6430
: ON ERRORE6$,Q6$GOTO 4340
4340 PRINT HEX(010A);HEX(07);"AN ERROR ";E6$;" HAS OCCURED ON LINE ";Q6$
: GOSUB '254
: GOSUB '31
4390 GOSUB '100("N,Y","NnYyY ",1,1,"DO YOU WISH TO SAVE DATA (Y OR N)",2)
: GOSUB 4490
: IF Q6$="Y"THEN RETURN
: IF Q6$="N"THEN 4430
4430 RETURN CLEAR
4440 PRINT AT(1,0,)
: GOTO 6790
4460 RETURN
4490 IF Q6$<>HEX(1F)THEN RETURN
: PRINT AT(1,0,80);HEX(07);"THE PROGRAM WILL BE TERMINATED"
: GOSUB '31
4540 Q6$=K3$
: GOSUB '100(" "," ",8,0,"ENTER FILE NAME",3)
: K3$=Q6$
: PRINT AT(6,16,64);"2. FILE NAME = ";K3$
: RETURN
4610 K0$=HEX(A00553025202500151015302A00153025202520252025202A0015004510550015
002510250045004500453025302A01953025002A001A00150045004A01E)
: RETURN
4640 K0$=HEX(5002A009500251025002A0045004A0145004A001)
: RETURN
4680 DBACKSPACE #2,BEG
: DATA LOAD DC #2,I$()
: GOSUB 4610
: $UNPACK(F=K0$)I$()TO L8$,A,A0,B,B3,A1,A4$,A2,A3,A4,A5,B(),A3$,D4,D3,C1,C3
,C2,D2,B5,B4,B2,C5,Q6$,D1,C0,A1$,A0$,B0,B1,K5$
: UNPACK(-########.#)Q6$TO D,D0,G2,G1,G
: DATA LOAD DC #2,I$()
: GOSUB 4640
: $UNPACK(F=K0$)I$()TO K3,K1$,K1,K2,K9,K9$,I9,C0$,K(),K2$()
4760 GOSUB '219(K3$,2,S2,F7$,0)
: RETURN
4800 GOSUB 4610
: L8$="INVTS"
: PACK(-########.#)Q6$FROMD,D0,G2,G1,G
: $PACK(F=K0$)I$()FROML8$,A,A0,B,B3,A1,A4$,A2,A3,A4,A5,B(),A3$,D4,D3,C1,C3,
C2,D2,B5,B4,B2,C5,Q6$,D1,C0,A1$,A0$,B0,B1,K5$
: DATA SAVE DC #2,I$()
: GOSUB 4640
: $PACK(F=K0$)I$()FROMK3,K1$,K1,K2,K9,K9$,I9,C0$,K(),K2$()
: DATA SAVE DC #2,I$()
4880 GOSUB '218(K3$,2,F7$,0)
: GOSUB '219(K3$,2,S2,F7$,0)
: RETURN
4950 DEFFN'217(R9$,R9,R8,R1,Q9,Q6$,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8,R
: Q$="D"
: IF ABS(R)=1THEN 5050
: IF R1<=0THEN 4980
: IF R=2THEN 5050
: Q9=4
: Q$="S"
: IF R=0THEN 4960
: IF Q7-Q6+1<R1THEN 5050
: DATA SAVE DC OPEN T#R9,R9$,R9$
: GOTO 4990
4960 DATA SAVE DC OPEN T#R9,R1,R9$
: ERRORGOTO 5050
4970 LIMITS T#R9,Q6,Q7,Q8
: GOTO 4990
4980 IF R<2THEN 5050
4990 GOSUB 5080
: Q$="M"
: IF STR(R9$(1),4,4)<>HEX(FD4D5558)AND R1=-2THEN 5050
: IF STR(R9$(1),4,4)=HEX(FD4D5558)THEN 5000
: STR(R9$(1),4,4)=HEX(FD4D5558)
: R9$(2)=Q6$
: STR(R9$(),33)=" "
5000 Q$="P"
: IF Q6$<>R9$(2)THEN 5050
: Q$="A"
: Q6$=STR(R9$(),33,48)
: IF STR(Q6$,R8,1)=" "XOR R1<>-1THEN 5050
: STR(Q6$,R8,1)=" "
: ON Q9-1GOTO 5010,5020,5040
: R1$=" 1 2 3"
: GOTO 5030
5010 R1$=" 1 2"
: GOTO 5030
5020 R1$=" 1 3"
5030 $TRAN(Q6$,R1$)R
5040 IF Q6$<>" "THEN 5050
: CONVERT Q9TO STR(R9$(),32+R8,1),(#)
: GOSUB 5090
: DATA LOAD DC OPEN T#R9,R9$
: Q$=" "
5050 IF R2=0THEN $CLOSE#R9
: RETURN
5060 DEFFN'218(R9$,R9,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,Q6,Q7,Q8
: Q6=Q8-Q6+2
: R9$()=HEX(A0)
: DATA SAVE BA T#R9,(Q8)R9$()
: GOSUB 5080
: STR(R9$(),2,2)=BIN(Q6,2)
: GOSUB 5090
: DATA LOAD DC OPEN T#R9,R9$
: DSKIP #R9,END
: GOTO 5050
5070 DEFFN'219(R9$,R9,R8,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8
: GOSUB 5080
: STR(R9$(),32+R8,1)=" "
: GOSUB 5090
: DATA SAVE DC CLOSE#R9
: GOTO 5050
5080 DATA LOAD BA T#R9,(Q7,Q8)R9$()
: RETURN
5090 DATA SAVE BA T#R9,(Q7,Q8)R9$()
: RETURN
5120 DEFFN'91
: $TRAN(Q$,"0 1E2X3N4D5S6A7B8P")R
: CONVERT Q$TO J0
: IF J0<1OR J$(J0)=" "THEN 5180
: PRINT AT(3,0,80);HEX(07);J$(J0)
5180 J$()="END OF FILE IMPROPER CALL RECORD NOT FOUNDDUPLICATE KEY NO
MORE SPACE ACCESS CONFLICT RECORD BUSY INVALID PASSWORD"
: RETURN
5240 SELECT CO 005(64),PRINT 005(64)
: IF S0$<>" "THEN SELECT @PARTS0$
: IF S2=0THEN S2=#PART
: K4=4
: GOSUB 5180
: IF B1(1,1)=2THEN 6220
: K2$(1)="Y"
: K2$(2)="3"
: D5=.5
: B1(1,1)=2
: B1(2,1)=.6
: B1(1,2)=5
: B1(2,2)=.5
: B1(1,3)=10
: B1(2,3)=.4
: B1(1,4)=100
: B1(2,4)=.3
: B1(1,5)=9E99
: B1(2,5)=.2
: PRINT HEX(03);TAB(31);
5551 IF M6$="D"THEN PRINT "DEMAND SIMULATOR"
: ELSE PRINT "REORDER SIMULATOR"
: GOSUB 4040
: GOSUB 4540
: GOSUB 4140
5600 GOSUB '100("0","3",1,0,"ENTER ITEM NUMBER TO CORRECT (0=END)",1)
: GOSUB 4490
: IF Q9=0THEN 5670
: ON Q9GOSUB 4040,4540,4140
: GOTO 5600
5670 PRINT HEX(010A);"MOUNT DISK CONTAINING FILE ";K3$;" IN DISK DRIVE ";F7$
: GOSUB '254
: E7$="1"
: LIMITS T#2,K3$,H6,H7,B8,R
: ERRORGOTO 4290
5710 E7$=" "
: IF R=2THEN 5780
: IF R=0THEN 5765
5730 PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" IS NOT A SIMULATOR FILE"
: K3$=" "
: GOSUB 4540
: GOTO 5600
5765 PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" IS NOT ON DISK ";F7$
: GOTO 5600
5780 DATA LOAD BA T#2,(H6,H7)R9$()
: IF B8<>K4OR STR(R9$(1),4,5)<>"INVTS"THEN 5730
: GOSUB '217(K3$,2,S2,0,1," ",F7$,0)
: GOSUB '91
: IF J0<>0THEN 5600
: GOSUB 4680
: GOTO 6840
5870 A,A1=.1
: A2,A3=.2
: A0,A4=1
: B=6
: B3,A5=.5
: A4$="F"
: MAT B=CON
: A3$="S"
: C1,B5,B4=1
: D4=8
: D3,C2=4
: C3=28
: B2=.1
: C5=.95
: D5=.5
: D=100
: D0,G2=20
: B1,C0,D1,G,G1,I9=0
: A0$,A1$=HEX(00)
: B0=150
: K1$="01/01/78"
: IF P$="D"THEN 6130
: K1$="01/1/1/78"
6130 MAT K=ZER
: K3,K9=P
: K9$="0179"
: C0$="UNITS"
: GOTO 6840
6220 $UNPACK(F=HEX(610461046104510451045303500260046004A001A001))A6$()TO D,D0,
G2,G1,G,D1,C0,B0,B1,A1$,A0$
: PRINT AT(1,0,)
: K4$=K3$
: GOSUB 4390
: PRINT AT(5,16,64);"1. SAVE DATA - YES"
: GOSUB 4540
: GOSUB 4140
6430 GOSUB '100("0","3",1,0,"ENTER ITEM NUMBER TO CORRECT (0=END)",1)
: GOSUB 4490
: IF Q9=0THEN 6490
: ON Q9GOSUB 4390,4540,4140
: GOTO 6430
6490 PRINT HEX(010A);"MOUNT DISK ";
: IF K2$="SIMULATOR"AND K3$=K4$THEN PRINT "CONTAINING";
: ELSE PRINT "TO CONTAIN";
: PRINT " FILE ";K3$;" IN DISK DRIVE ";F7$
: GOSUB '254
: E7$="2"
: LIMITS T#2,K3$,H6,H7,B8,R
: ERRORGOTO 4290
6550 E7$=" "
: R1=K4
: IF R=0OR R=-2THEN 6730
: IF R=2THEN 6650
6600 PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" IS NOT A SIMULATOR FILE"
6610 K3$=" "
: GOSUB 4540
: GOTO 6430
6650 IF K2$="SIMULATOR"AND K3$=K4$THEN 6690
: PRINT AT(3,0,80);HEX(07);"FILE ";K3$;" ALREADY EXISTS ON DISK"
: GOTO 6610
6690 DATA LOAD BA T#2,(H6,H7)R9$()
: IF B8<>K4OR STR(R9$(1),4,5)<>"INVTS"THEN 6600
: R1=0
6730 GOSUB '217(K3$,2,S2,R1,4," ",F7$,0)
: GOSUB '91
: IF J0<>0THEN 6430
: GOSUB 4800
: K2$="SIMULATOR"
6790 GOSUB '100("N,Y","NnYyY ",1,1,"DO YOU WISH TO MODIFY THE DATA AND RE-RUN
(Y OR N)",2)
: GOSUB 4490
: IF Q6$="N"THEN GOSUB '31
6840 IF M6$="D"THEN Q6$="DEMAND"
: ELSE Q6$="REORDER"
: PRINT AT(1,0,);AT(11,17);"* * LOADING ";Q6$;" SIMULATOR INPUT ROUTINE *
*"
: Q6$=M5$
: STR(Q6$,7,1)="2"
: LOAD TQ6$4000,7999BEG 4000
8050 DEFFN'100(Q$(1),Q$(2),Q3,Q4,Q7$,Q5)
: Q6=Q9
: SELECT PRINT 005(80)
: IF Q7$<>" "THEN PRINT HEX(010A);Q7$;TAB(80)
8060 KEYIN Q7$,8060,8060
8070 Q7$=" "
: Q7=Q3+Q4+2+17*(1-ABS(SGN(Q3+Q4)))
: IF Q5>1THEN Q7=Q3+64*(1-ABS(SGN(Q3)))
: PRINT AT(2,0,80);
: IF Q5>-1AND Q5<3THEN 8080
: STR(Q6$,Q7+1)=" "
: LINPUT -STR(Q6$,,Q7)
: GOTO 8100
8080 Q6$=ALL(8B)
: IF Q5>1THEN 8090
: STR(Q6$,Q3+1,1)="."
: STR(Q6$,Q7)=" "
: Q7$="Default = "&Q6$&"-"
: $TRAN(Q7$,HEX(238B))R
: PRINT AT(2,Q7+3);
: IF Q5=0THEN PRINTUSING Q7$,Q9;
: PRINT HEX(0D)
: Q7$=Q6$
8090 LINPUT ?STR(Q6$,,Q7)
: IF Q5=0AND Q6$=Q7$THEN Q7=0
: IF Q5=1AND Q6$=Q7$THEN Q6$="0"
8100 $TRAN(Q6$,HEX(208B))R
: IF Q7$=HEX(0F)THEN 8070
: IF Q6$=HEX(1F)THEN 8150
: IF Q5>1THEN 8160
: $TRAN(STR(Q6$,POS(Q6$=".")+1)," .")R
: $TRAN(Q7$,HEX(238B))R
: MAT COPY -Q7$<1,16>TO -Q7$<2,17>
: STR(Q7$,,1)="-"
: IF Q7=0THEN CONVERT Q9TO Q6$,(Q7$)
: CONVERT Q$(1)TO Q7
: ERRORQ7=0
8110 CONVERT Q$(2)TO Q8
: ERRORQ8=0
8120 CONVERT Q6$TO Q9
: ERRORGOTO 8180
8130 IF Q3+Q4=0THEN 8140
: IF ABS(Q9)>=10^ABS(Q3)OR INT(Q9*10^Q4)<>Q9*10^Q4THEN 8180
8140 IF Q7=0AND Q8=0THEN 8150
: IF Q9<Q7OR Q9>Q8THEN 8180
8150 PRINT AT(1,0,240)
: RETURN
8160 IF Q$()=" "THEN 8150
: IF Q4=0AND Q$(1)<=Q6$AND Q$(2)>=Q6$THEN 8150
: Q7$=HEX(07)
: IF Q4=0THEN 8170
: IF Q4=1THEN $TRAN(STR(Q6$,,Q3),Q$(2))R
: Q7=LEN(Q$(1))
: MAT SEARCHSTR(Q$(1),,Q7),=STR(Q6$,,Q3)TO STR(Q7$,,2)STEP Q3+1
: Q9=INT((VAL(Q7$,2)+Q3)/(Q3+1))
: IF Q9>0THEN 8150
: Q7$=" - "&STR(Q$(1),,Q7)&HEX(07)
8170 PRINT AT(3,0,80);"Re-enter.";Q7$
: GOTO 8070
8180 Q7$=HEX(07)
: IF Q$()=" "THEN 8170
: PRINT AT(3,0,80);Q7$;"Re-enter, ";Q7;"<= X <=";Q8
: Q9=Q6
: GOTO 8070
8400 DEFFN'15
: Q7$=HEX(0F)
: RETURN
8415 DEFFN'4
: IF Q5>1THEN Q6$="END"
: ELSE Q6$="0"
: RETURN
8685 DEFFN'254
: KEYIN Q6$,8685,8685
: SELECT PRINT 005
: PRINT AT(2,0);TAB(80);AT(2,0);
: Q6$=" "
: INPUT "KEY RETURN(EXEC) TO RESUME",Q6$
: PRINT AT(1,0);TAB(80),TAB(80),TAB(80)
: RETURN
9035 DEFFN'126
9040 DEFFN'31
: PACK(####)Q6$FROMS2
: $TRAN(@I0$,Q6$)R
: COM CLEAR A6$()
: LOAD TM$
9998 DEFFN'29"Q$=";HEX(22);"FCST120A";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)