The Sinclair QL Forum

Code: Select all

10 REMark $$chan=4
11 :
12 REMark + ---------------------------------------------------- +
13 REMark |<                   SBasic to Obj                    >|
14 REMark + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
15 REMark | Converts SBasic programs to a Q_Liberator object     |
16 REMark | file using the QLib compiler                         |
17 REMark |                                                      |
18 REMark | Adds line numbers to numberless code via intermed-   |
19 REMark | iary file in a temporary directory                   |
20 REMark |                                                      |
21 REMark | Add to FileInfo2, Hotkey, or use with EX:            |
22 REMark |                                                      |
23 REMark | er = FEW(<sb2obj>;"<program>_bas [;<command_line>]") |
24 REMark |                                                      |
25 REMark | sb2obj passes the optional <command_line> to QLib    |
26 REMark | Use this to supply standard QLib cmdl parameters     |
27 REMark | (see Q_Liberator manual), except the file name.      |
28 REMark |                                                      |
29 REMark | Version 1.02, pjw, 2oi5, SBASIC only!                |
30 REMark + ---------------------------------------------------- +
31 :
32 REMark       Config:
33 qlb$ = 'win2_bas_qlib_obj': REMark QLib
34 out$ = '': REMark Default html output = input directory
35 tmp$ = 'ram1_sbhtmxxx': REMark Location and name of temp file
36 first% = 1: step% = 1: REMark First line and step size
37 :
38 REMark       Get input file name
39 REMark Get it either from cmdl or from Stufferbuffer
40 l% = LEN(CMD$)
41 IF l% = 0 THEN
42  fnm$ = HOT_GETSTUFF$: l% = LEN(fnm$)
43 ELSE
44  fnm$ = CMD$
45 END IF
46 IF l% < 9: Bye -12
47 :
48 REMark       Process command line(s)
49 com$= ''
50 REMark Additional command line?
51 s% = ';' INSTR fnm$
52 IF s% THEN
53  IF s% < l%: com$ = fnm$(s% + 1 TO l%)
54  l% = s% - 1: fnm$ = fnm$(1 TO l%)
55 END IF
56 :
57 :
58 REMark       Extract name and dir from file name
59 ci = FOP_DIR(fnm$): IF ci < 0: Bye ci
60 dir$ = FNAME$(#ci): CLOSE#ci
61 ci = FOP_IN(fnm$): IF ci < 0: Bye ci
62 ld% = len(dir$)
63 if out$ = '' then
64  out$ = fnm$(1 to 5) & dir$
65  if ld%: out$ = out$ & '_'
66 endif
67 nm$ = fnm$(6 + (ld% > 0) + ld% TO l% - 4)
68 :
69 REMark       Filter by extension
70 IF fnm$(l% - 2 TO l%) == 'sav' THEN
71  REMark _sav files pass straight through
72  bas = 0
73  CLOSE#ci
74 ELSE
75  REMark _bas file w/wo line number
76  IF fnm$(l% - 2 TO l%) == 'bas' THEN
77   bas = 1
78  ELSE
79   REMark Wrong file type
80   Bye -15
81  END IF
82  :
83  REMark Line numbers or not?
84  INPUT#ci; l$
85  IF NOT l$(1) INSTR '123456789' THEN
86   :
87   REMark     Process line numberless file
88   fnm$ = tmp$ & '_bas'
89   co = FOP_OVER(fnm$): IF co < 0: Bye co
90   bas = 2: i% = first%: lno$ = i%
91   BPUT#co; lno$, 32, l$, 10
92   :
93   FOR i% =  first% + step% TO 32767 STEP step%
94    IF EOF(#ci): EXIT i%
95    INPUT#ci; l$: lno$ = i%
96    BPUT#co; lno$, 32, l$, 10
97   END FOR i%
98   CLOSE#co
99  END IF
100  CLOSE#ci
101  :
102  REMark     Process non-sav files
103  REMark Use SBasic daughter to tokenise program
104  pip$ = 'pipe_p' & HEX$(JOBID, 32)
105  co = FOPEN(pip$ & 'o_2048'): IF co < 0: Bye co
106  :
107  REMark Slave will take instructions from here
108  cm$ = 'ci = fop_in(#0; "' & pip$ & 'o")'
109  :
110  REMark Plumb in to SBASIC Thing
111  EXEP 'SBASIC'; cm$
112  :
113  REMark Tell it what we want
114  PRINT#co; 'load "' & fnm$ & '"'
115  PRINT#co; 'qsave_o "' & tmp$ & '"'
116  PRINT#co; 'beep 2,2: beep 2,2': REMark Signal success
117  PRINT#co; 'quit': REMark Job done! Get rid of slave
118  fnm$ = tmp$ & '_sav'
119 END IF
120 :
121 REMark      Create QLib command line
122 com$ = fnm$ & ' -OBJ ' & out$ & nm$ & ' -NAME ' & nm$ &' '& com$
123 IF bas = 2: com$ = com$ & ' -NOLINE'
124 :
125 REMark      Compile!
126 Bye FEW(qlb$; com$)
128 :
129 REMark      Tidy and quit
130 DEFine PROCedure Bye(er)
131 beep 2,2: rem Wake up QPC sound
132 IF er < 0: BEEP 3000,255: else: beep 2, 2
133 :
134 REMark Remove any temporary files
135 IF bas: DELETE fnm$
136 IF bas = 2: DELETE tmp$ & '_bas'
137 QUIT er
138 END DEFine Bye