image of READY prompt

Wang2200.org

Listing of file='IDS2PP15' on disk='vmedia/701-2725B.wvd.zip'

# Sector 157, program filename = 'IDS2PP15'
1000 REM "IDS2PP15" - INTERACTIVE PROGRAM GENERATOR - P/F SPECS I&J COPY
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : F5$=F1$
   : GOSUB 3050
   : J5$=E8$
   : F5$=F2$
   : GOSUB 3050
   : E0$()="Copy"
   : IF C9>9THEN 2000
1036 IF STR(F1$,,4)="HEX("AND VER(STR(F1$,5,3),"HH)")=3THEN 1170
   : MAT SEARCH"@SYSBUF0BLANKFLDCPU ID #STATION#TERMINALPARTIT'NOPERATORUSERCL
     ASNEWTRAN#NEXTSEQ#",=STR(F1$,,8)TO F9$STEP 8
   : ON (VAL(F9$,2)+7)/8GOTO 1070,1080,1090,1100,1110,1120,1130,1140,1150,1160
   : IF J5$>"261"AND J5$<"269"AND E8$>"261"AND E8$<"269"THEN 1060
1040 E4$()=E4$()&HEX(9A)&"'64("&J5$&","&E8$&")"&HEX(BA)
1050 IF J5$>"250"AND J5$<"261"OR J5$<"250"THEN E0$()=E0$()&" field "&HEX(22)&F
     1$&HEX(22)
   : IF J5$="250"THEN E0$()=E0$()&" all blanks"
   : IF J5$="261"THEN E0$()=E0$()&" the work buffer"
   : IF J5$>"261"THEN E0$()=E0$()&" record "&HEX(22)&F1$&HEX(22)
   : GOTO 1800
1060 CONVERT E8$TO Q
   : CONVERT Q-260TO F9$,(#)
   : ERRORF9$=" "
1063 E4$()=E4$()&HEX(D3)&"E$(),E("&F9$&"),E0("&F9$&"))="
   : CONVERT J5$TO Q
   : CONVERT Q-260TO F9$,(#)
   : ERRORF9$=" "
1066 E4$()=E4$()&HEX(D3)&"E$(),E("&F9$&"),E0("&F9$&"))"&HEX(BA)
   : IF POS("RB"=STR(R3$(),6,1))>0THEN E4$()=E4$()&HEX(9A273731BA)
   : GOTO 1050
1070 E4$()=E4$()&HEX(9A)&"'45("&E8$&",R7$(1))"
   : E0$()="Copy @SYSBUF0"
   : GOTO 1500
1080 E4$()=E4$()&HEX(9A)&"'45("&E8$&HEX(2C22202229)
   : E0$()="Copy blanks"
   : GOTO 1500
1090 E4$()=E4$()&HEX(9A)&"'XX("&E8$&HEX(2CD7494429)
   : E0$()="Copy the CPU ID #"
   : GOTO 1500
1100 E4$()=E4$()&HEX(9A)&"'XX("&E8$&","&"R0)"
   : E0$()="Copy the station #"
   : GOTO 1500
1110 E4$()=E4$()&HEX(9A)&"'XX("&E8$&HEX(2CD75445524D29)
   : E0$()="Copy the terminal #"
   : GOTO 1500
1120 E4$()=E4$()&HEX(9A)&"'XX("&E8$&HEX(2CD75041525429)
   : E0$()="Copy the partition #"
   : GOTO 1500
1130 E4$()=E4$()&HEX(9A)&"'45("&E8$&",R4$)"
   : E0$()="Copy the operator ID"
   : GOTO 1500
1140 E4$()=E4$()&HEX(9A)&"'45("&E8$&",R8$)"
   : E0$()="Copy the operator user class"
   : GOTO 1500
1150 E4$()=E4$()&HEX(EAB42332BA97A1BE5423322C28DC)&"@E2$(3),2))E4$()"&HEX(BAAE
     D3)&"E4$(),,8)"&HEX(B2513A513DF9)&"Q+1,1E8)"&HEX(BAAE51B2D3)&"E4$(),,8),(
     ########)"&HEX(BA9785BE5423322C28DC)&"@E2$(3),2))E4$()"&HEX(BAEAE32332BA9
     A)&"'XX("&E8$&",Q)"
1151 E0$()="Copy next transaction number"
   : GOTO 1500
1160 E4$()=E4$()&HEX(9A)&"'XX("&E8$&HEX(2CDC)&"F6$(16)))"&HEX(BAE8)&"(F6$(16),
     01)"
   : E0$()="Copy next sequence number"
   : GOTO 1500
1170 E4$()=E4$()&"E4$()="&HEX(E128)&STR(F1$,5,3)&HEX(BAEA)&"TRAN(E4$(),"&HEX(D
     2)&"20000020))R"&HEX(BA9A)&"'45("&E8$&",E4$())"
   : E0$()="Copy all HEX("&STR(F1$,5,3)&"'s"
1500 F1$=F2$
   : E4$()=E4$()&HEX(BA)
   : MAT SEARCHE4$(),="'XX"TO F9$
   : IF F9$=HEX(0000)THEN 1800
   : STR(E4$(),VAL(F9$,2),3)="'55"
1800 E0$()=E0$()&" to"
1810 IF E8$>"250"AND E8$<"261"OR E8$<"250"OR E8$="269"THEN E0$()=E0$()&" field
      "&HEX(22)&F2$&HEX(22)
   : IF E8$="250"THEN E0$()=E0$()&" nothing (**** ERROR ****)"
   : IF E8$="261"THEN E0$()=E0$()&" the work buffer"
   : IF E8$>"261"AND E8$<"269"THEN E0$()=E0$()&" record "&HEX(22)&F2$&HEX(22)
   : GOTO 3000
2000 E4$()=E4$()&HEX(9A)&"'43("&J5$&HEX(29BA)&"F5$=E$"&HEX(BA)
   : E4$()=E4$()&HEX(9A)&"'43("&E8$&HEX(29BA)
   : IF POS("RB"=STR(R3$(1),6,1))>0THEN E4$()=E4$()&"E0$=E9$(1)"&HEX(8BE1)&"(2
     0)"&HEX(BA)
   : E4$()=E4$()&HEX(9A)&"'65(F5$,E4$())"&HEX(BA)
2030 E0$()="Copy indirect using "&HEX(22)&F1$&HEX(22)&" and "&HEX(22)&F2$&HEX(
     22)
3000 IF E2(2)>0THEN E4$()=E4$()&HEX(A2)&E0$()&HEX(BA)
   : IF STR(E4$(),LEN(E4$()))=HEX(BA)THEN STR(E4$(),LEN(E4$()))=HEX(1B)
   : IF POS(E4$()=BA)>0THEN E$=F0$
   : IF E$<>" "THEN STR(F$(),LEN(F$())+1)=E$
   : IF E4$()<>" "THEN STR(F$(),LEN(F$())+1)=STR(E4$(),POS(E4$()>20))
   : LOAD DA T#2,(D$(13))1000,
3020 STOP #
   : PRINT HEX(06020402000E);AT(23,16);"Compiling BASIC program - Now processi
     ng sector";E4-E3+1;
   : RETURN
3040 STOP "END IT"
3050 Q=250
   : IF F5$=" "THEN 3060
   : MAT SEARCHE3$(),=STR(F5$,,8)TO F9$STEP 8
   : IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)
   : IF Q<250THEN 3060
   : IF VER(F5$,"@TSTFLD#")=8THEN Q=VAL(STR(F5$,8))+203
   : MAT SEARCHC8$,=STR(F5$,,8)TO F9$
   : IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)+260
   : IF F5$="@SYSBUF0"THEN Q=269
3055 IF F5$>"FILE # 0"AND F5$<"FILE # 8"THEN Q=VAL(STR(F5$,8))+213
3060 DEFFN'71(Q)
   : E8$=" "
   : $PACK(F=HEX(1006))E8$FROMQ
   : E8$=STR(E8$,POS(E8$>20))
   : RETURN
3070 IF STR(F5$,,2)="IF"THEN F9$=HEX(8A)
   : IF STR(F5$,,2)="OR"THEN F9$=HEX(8B)
   : IF LEN(E$)>1THEN E$=E$&F9$
   : $TRAN(F9$,HEX(8A8B8B8A))R
   : IF LEN(F0$)>1THEN F0$=F0$&F9$
   : RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PP15"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"