home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / f / insdmbas.lbr / PC.BZS / PC.BAS
Encoding:
BASIC Source File  |  1993-10-26  |  5.4 KB  |  121 lines
  1. 10000 REM       MBASIC PROGRAM CONCENTRATOR
  2. 10010 REM              VERSION 2.2
  3. 10040 REM INITIALIZE
  4. 10050 DEFINT A-Z:OPTION BASE 1:PA=0:BC$="":BF$="":LD=0
  5. 10060 OPEN "I",1,"XREF.DAT"
  6. 10061 INPUT #1, COMM$,STRT!
  7. 10062 INPUT #1, COMM$,CLS
  8. 10063 CLOSE #1
  9. 10064 CLS$=CHR$(CLS)
  10. 10070 DEF FNAC$(RB,CK)=EB$+"Y"+CHR$(31+RB)+CHR$(31+CK)
  11. 10080 DEF FNPD$(NE!)=CHR$(NE!-INT(NE!/256)*256)+CHR$(INT(NE!/256))
  12. 10090 DEF FNUA!(PC$)=ASC(LEFT$(PC$,1))+ASC(RIGHT$(PC$,1))*256
  13. 10100 DEF FNGA(CA$,WA$,PG)=INSTR(CA$,MID$(WA$,PG,1))
  14. 10110 'MAKE TERST STRINGS
  15. 10120 CB$=CHR$(9)+CHR$(10)+CHR$(32)+CHR$(0)
  16. 10130 CC$=CHR$(15)+CHR$(11)+CHR$(12)+CHR$(14)+CHR$(28)+CHR$(29)+CHR$(31)+CHR$(34)
  17. 10140 CD$="ABCDEFGHIJKLMNOPQRSTUVWXYZ":CE$=".1234567890"
  18. 10150 CF$="%!#$":CG$=CHR$(143):CH$=CHR$(137)+CHR$(139)
  19. 10160 ' SCREEN FORMAT
  20. 10170 PRINT CLS$:PRINT "BASIC PROGRAM CONCENTRATOR   [ 2.2 ]":PRINT
  21. 10180 PRINT "INPUT FILE MUST BE SAVED WITHOUT 'A' OR 'P' OPTION"
  22. 10190 PRINT "IF DRIVE IS NOT SPECIFIED, DEFAULT IS ASSUMED"
  23. 10200 PRINT "IF .EXT  IS NOT SPECIFIED, '.BAS ' IS ASSUMED"
  24. 10210 PRINT "FileName.CRF MUST HAVE BEEN CREATED BY XREF.BAS"
  25. 10220 PRINT "AND BE ON SAME DISK AS INPUT FILE":PRINT:PRINT
  26. 10230 INPUT "INPUT FILENAME : ";RA$:IF RA$="" THEN END
  27. 10240 PRINT CLS$
  28. 10250 ' MAKE FILE NAME
  29. 10260 IF INSTR(RA$,".")>1 THEN PF$=RA$:RA$=LEFT$(RA$,INSTR(RA$,".")-1) ELSE PF$=RA$+".BAS"
  30. 10270 CM$=RA$+".CRF":NC$=RA$+".A"
  31. 10280 ' GET PROGRAM STATS
  32. 10290 OPEN "I", 1, CM$:INPUT #1, HA,HB,SA!:NA!=SA!:DIM LF(HA)
  33. 10300 ' LOAD LINE REF ARRAY
  34. 10310 FOR LD=1 TO HA:INPUT #1,LF(LD):NEXT
  35. 10320 ' LOAD VAR LIST - MAKE NEW VAR NAMES
  36. 10330 DIM VB$(HB,2):LA$="A":FOR LD=1 TO HB:INPUT #1,VB$(LD,1)
  37. 10340 TB$=VB$(LD,1):FA$=LEFT$(TB$,1):IF FA$<>LA$ THEN RESTORE:LA$=FA$
  38. 10350 IF RIGHT$(TB$,1)="(" THEN PE=1:TB$=LEFT$(TB$,LEN(TB$)-1) ELSE PE=0
  39. 10360 IF INSTR(CF$,RIGHT$(TB$,1)) > 1 THEN TD$=RIGHT$(TB$,1):TB$=LEFT$(TB$,LEN(TB$)-1) ELSE TD$=""
  40. 10370 IF LEN(TB$) < 2 THEN 10390
  41. 10380 READ SB$:TB$=FA$+SB$
  42. 10390 IF TD$ <> "" THEN TB$=TB$+TD$
  43. 10400 IF PE=1 THEN TB$=TB$+"("
  44. 10410 VB$(LD,2)=TB$:NEXT:CLOSE
  45. 10420 ' OPEN INPUT FILE
  46. 10430 OPEN "R",1 ,PF$:FIELD#1,128 AS BB$:GET #1
  47. 10440 IF LEFT$(BB$,1) <> CHR$(255) THEN PRINT "WRONG FILE FORMAT":END
  48. 10450 BE$=MID$(BB$,2):GET #1:PRINT CLS$:PRINT "PROGRAM NAME - ";PF$
  49. 10460 OPEN "O",2, NC$
  50. 10470 PRINT #2, CHR$(255);:' START OUTPUT FILE
  51. 10480 BD=LEN(BE$):BC$="":PA=1:IF BD<128 THEN BE$=BE$+BB$:GET#1
  52. 10490 AA$=LEFT$(BE$,2):IF AA$ <> CHR$(0)+CHR$(0) THEN 10520
  53. 10500 IF LEN(BG$) > 0 THEN GOSUB 11060
  54. 10510 GOTO 11100
  55. 10520 LB=FNUA!(AA$)-SA!:SA!=SA!+LB:LC$=MID$(BE$,3,2)
  56. 10530 LE=FNUA!(LC$):TA=0
  57. 10540 ' TARGET LINE
  58. 10550 FOR LD=1 TO HA:IF LE=LF(LD) THEN TA=1:LD=HA
  59. 10560 NEXT
  60. 10570 PRINT "PROCESSING LINE : ";FNUA!(LC$)
  61. 10580 ' GET A LINE OF BASIC
  62. 10590 BE$=MID$(BE$,5):BD=LEN(BE$):LB=LB-4
  63. 10600 IF BD  < LB THEN BC$=BC$+BE$:BE$=BB$:GET #1:LB=LB-BD:BD=LEN(BE$):GOTO 10600
  64. 10610 BC$=BC$+LEFT$(BE$,LB):BE$=MID$(BE$,LB+1)
  65. 10620 ' TIME SAVING PREPROSSOR
  66. 10630 IF TA > 0 THEN BA=1
  67. 10640 IF FNGA(CHR$(9)+CHR$(10)+CHR$(32),BC$,1)>0 THEN BC$=MID$(BC$,2):GOTO 10640
  68. 10650 IF LEFT$(BC$,1)=":" OR LEFT$(BC$,1)=CHR$(143) THEN IF BA=1 THEN AB=1:BF$=LEFT$(BC$,LEN(BC$)-1):GOTO 10990 ELSE 10480
  69. 10660 IF LEFT$(BC$,1)=CHR$(132) THEN BF$=LEFT$(BC$,LEN(BC$)-1):BA=1:AB=1:GOTO 10990
  70. 10670 ' EXAMINE LINE ONE CHAR AT A TIME
  71. 10680 ON FNGA(CB$,BC$,PA) GOTO 10780,10780,10780,10990
  72. 10690 ON FNGA(CC$,BC$,PA) GOTO 10830,10820,10820,10820,10820,10810,10800,10850
  73. 10700 IF FNGA(CD$,BC$,PA) > 0 THEN 10890
  74. 10710 IF FNGA(CG$,BC$,PA) = 0 THEN 10740
  75. 10720 IF PA=1 THEN 10970
  76. 10730 IF FNGA(CHR$(255),BC$,PA-1) = 0 THEN 10970
  77. 10740 IF FNGA(CH$,BC$,PA) = 0 THEN 10770
  78. 10750 IF PA= 1 THEN AB=1:GOTO 10770
  79. 10760 IF FNGA(CHR$(255),BC$,PA-1) = 0 THEN AB=1
  80. 10770 BF$=BF$+MID$(BC$,PA,1)
  81. 10780 PA=PA+1:GOTO 10680:' SKIP THIS CHAR ,  GET ANOTHER
  82. 10790 ' NUMERIC CONSTANTS
  83. 10800 BF$=BF$+MID$(BC$,PA,4):PA=PA+4:' PASS  8 BYTE NO.
  84. 10810 BF$=BF$+MID$(BC$,PA,2):PA=PA+2:' PASS 4 BYTE NO.
  85. 10820 BF$=BF$+MID$(BC$,PA,1):PA=PA+1:' PASS 2 BYTE NO.
  86. 10830 BF$=BF$+MID$(BC$,PA,2):PA=PA+2: GOTO 10680:' PASS 1 BYTE NO.
  87. 10840 ' STRING CONSTANTS
  88. 10850 PB=INSTR(PA+1,BC$,CHR$(34))
  89. 10860 IF PB=0 THEN PB=LEN(BC$):BC$=LEFT$(BC$,PB-1)+CHR$(34)+CHR$(0)
  90. 10870 BF$=BF$+MID$(BC$,PA,PB-PA+1):PA=PB+1:GOTO 10680
  91. 10880 ' VARS
  92. 10890 VA$="":LD=0
  93. 10900 VA$=VA$+MID$(BC$,PA,1):PA=PA+1
  94. 10910 IF FNGA(CD$+CE$,BC$,PA) > 0 THEN 10900
  95. 10920 IF FNGA(CF$,BC$,PA) > 0 THEN VA$=VA$+MID$(BC$,PA,1):PA=PA+1
  96. 10930 IF MID$(BC$,PA,1) = "(" THEN VA$=VA$+"(":PA=PA+1
  97. 10940 ' IF THIS IS A VAR NAME THEN SHORTEN IT
  98. 10950 LD=LD+1:IF VA$=VB$(LD,1) THEN BF$=BF$+VB$(LD,2):GOTO 10680
  99. 10960 IF LD=HB THEN BF$=BF$+VA$:GOTO 10680 ELSE 10950
  100. 10970 IF MID$(BC$,PA-1,1)=":" THEN BF$=LEFT$(BF$,LEN(BF$)-1):PA=PA-1:GOTO 10970
  101. 10980 ' FILE BUILDING DECISIONS
  102. 10990 IF BG$="" THEN GOSUB 11050:BA=0:GOTO 11020
  103. 11000 IF BA=1 THEN BA=0:GOSUB 11060:GOSUB 11050:GOTO 11020
  104. 11010 IF LEN(BG$)+LEN(BF$) < 100 THEN GOSUB 11080 ELSE GOSUB 11060:GOSUB 11050
  105. 11020 IF AB = 1 THEN AB=0:GOSUB 11060
  106. 11030 GOTO 10480
  107. 11040 ' BUILD NEW FILE
  108. 11050 BG$=BF$:BF$="":ND$=LC$:RETURN
  109. 11060 NA!=NA!+LEN(BG$)+5
  110. 11065 NB$=FNPD$(NA!)
  111. 11070 PRINT #2,NB$;ND$;BG$;CHR$(0);:BG$="":RETURN
  112. 11080 BG$=BG$+":"+BF$:BF$="":RETURN
  113. 11090 ' CLOSE NEW FILE
  114. 11100 PRINT #2,CHR$(0);CHR$(0);CHR$(26);
  115. 11110 CLOSE
  116. 11120 RUN "MENU.BAS"
  117. 11130 ' DATA
  118. 11140 DATA A,B,C,D,E,"2",G,H,"3",J,K,L,M,"4","5",P,Q,"6","7",T,U,V,W,X,Y,Z
  119. 
  120. 11110 CLOSE
  121. 1