home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / BASUT-01.ZIP / LBL-BAS.BAS < prev    next >
BASIC Source File  |  1983-05-14  |  3KB  |  48 lines
  1. 1000 DEFINT A-Z:DIM PTAB$(1000),LTAB(1000):TRUE=(1=1):FALSE=NOT TRUE:PTMAX=-1:CLS:INPUT "Enter   input filename: ",INFILE$:INPUT "Enter  output filename: ",OUTFILE$:INPUT "Enter listing filename: ",LSTFILE$:FOR PASS=1 TO 2
  2. 1001 PRINT "Beginning pass ";PASS;" ";TIME$:FILENO=2:OPEN INFILE$ FOR INPUT AS #FILENO:IF PASS=1 THEN OPEN LSTFILE$ FOR OUTPUT AS #1 ELSE OPEN OUTFILE$ FOR OUTPUT AS #1
  3. 1002 LNBR=1000:LINC=1:OU$=""
  4. 1003 GOSUB 1009:IF STMT$="" THEN 1008
  5. 1004 IF (LEN(OU$)+LEN(STMT$)>200) OR FORCENEW THEN GOSUB 1046:OU$=""
  6. 1005 IF OU$<>"" THEN OU$=OU$+":"
  7. 1006 OU$=OU$+STMT$:IF FOUNDIF THEN FORCENEW=TRUE:FOUNDIF=FALSE
  8. 1007 GOTO 1003
  9. 1008 GOSUB 1046:CLOSE #1:CLOSE #FILENO:NEXT PASS:BEEP:PRINT "End of run ";TIME$:BEEP:END
  10. 1009 STMT$="":NEWLAB=FALSE
  11. 1010 IF EOF(FILENO) THEN 1026
  12. 1011 LINE INPUT #FILENO,IN$:IF PASS=1 THEN PRINT #1,IN$
  13. 1012 INMAX=LEN(IN$):IF INMAX<1 THEN 1010
  14. 1013 W$=LEFT$(IN$,1):INIX=1:IF W$="*" THEN 1010
  15. 1014 IF W$="@" THEN GOSUB 1028
  16. 1015 GOSUB 1035:IF WORD$="COPY" THEN 1024 ELSE 1017
  17. 1016 GOSUB 1035
  18. 1017 IF LEFT$(WORD$,1)="@" THEN GOSUB 1030
  19. 1018 IF STMT$<>"" AND WORD$<>"" AND RIGHT$(STMT$,1)<>":" AND WORD$<>":" THEN STMT$=STMT$+" "
  20. 1019 STMT$=STMT$+WORD$:IF WORD$="IF" THEN FOUNDIF=TRUE
  21. 1020 IF WORD$<>"" THEN 1016
  22. 1021 IF INIX<=INMAX THEN IF W$="~" THEN 1010
  23. 1022 IF STMT$="" THEN 1010
  24. 1023 RETURN
  25. 1024 GOSUB 1035:FILENO=FILENO+1:ON ERROR GOTO 1025:OPEN WORD$ FOR INPUT AS #FILENO:ON ERROR GOTO 0:PRINT "Now copying ";WORD$:GOTO 1010
  26. 1025 ON ERROR GOTO 0:BEEP:PRINT "File ";INFILE$;" not found; ignored":FILENO=FILENO-1:GOTO 1010
  27. 1026 IF FILENO=2 THEN 1023
  28. 1027 CLOSE #FILENO:FILENO=FILENO-1:GOTO 1010
  29. 1028 FORCENEW=TRUE:GOSUB 1035:IF PASS=2 THEN RETURN
  30. 1029 PTMAX=PTMAX+1:PTAB$(PTMAX)=WORD$:LTAB(PTMAX)=LNBR+LINC:RETURN
  31. 1030 IF PASS=1 THEN WORD$="9999":RETURN
  32. 1031 PTIX=0
  33. 1032 IF PTIX>PTMAX THEN BEEP:PRINT "Unresolved label: ";WORD$:WORD$="9999":RETURN
  34. 1033 IF PTAB$(PTIX)=WORD$ THEN WORD$=RIGHT$(STR$(LTAB(PTIX)),4):RETURN
  35. 1034 PTIX=PTIX+1:GOTO 1032
  36. 1035 WORD$="":QUOTE=FALSE
  37. 1036 IF INIX>INMAX THEN RETURN
  38. 1037 IF MID$(IN$,INIX,1)=" " THEN INIX=INIX+1:GOTO 1036
  39. 1038 W$=MID$(IN$,INIX,1):IF QUOTE THEN 1042
  40. 1039 IF W$=":" THEN IF WORD$="" THEN WORD$=W$:INIX=INIX+1:RETURN
  41. 1040 IF W$=":" OR W$="'" OR W$=" " OR W$="~" THEN RETURN
  42. 1041 IF W$<" " OR W$>"z" THEN 1044
  43. 1042 IF W$=CHR$(34) THEN QUOTE=TRUE-QUOTE
  44. 1043 WORD$=WORD$+W$
  45. 1044 INIX=INIX+1:IF INIX<=INMAX THEN 1038
  46. 1045 RETURN
  47. 1046 IF PASS=2 AND OU$<>"" THEN PRINT #1,RIGHT$(STR$(LNBR),4);" ";OU$
  48. 1047 LNBR=LNBR+LINC:FORCENEW=FALSE:RETURN