procedure errorprocedure errorprocedure errorprocedure errorprocedure errorprocedure errorprocedure paroptprocedure setflgprocedure setflgprocedure setflgprocedure setflgfunction schfil: (unknown)function chkexcl: (unknown)function schexc: (unknown)procedure dolistprocedure fndfilmodprocedure fndfilprocedure makpthprocedure dousesprocedure skpsrcprocedure logfilprocedure wrtfilprocedure prtreeprocedure dmppkgprocedure stdlibprocedure schsioprocedure schgwnprocedure fndpkgfunction inpkg: (unknown)function schpkg: (unknown)procedure addpkgprocedure lnkpkgprocedure fndlnkprocedure putchrprocedure plcfilprocedure plcetyprocedure schstdiofunction inlist: (unknown)procedure schleaffunction resvd: (unknown)procedure schresprocedure schnlsprocedure excactprocedure doactprocedure putchrprocedure putstrprocedure putflgprocedure plcpassprocedure doactsprocedure dolinkprocedure putchrprocedure putstrprocedure catfilsprocedure regfilprocedure chkexcprocedure regfilsprocedure parinstprocedure inserrprocedure lskpspcprocedure parfilstrprocedure cleanpathType: array
libs that can be substituted for standard serial library
Type: array
Type: array
Type: boolean
passthrough options: these have "set/not set indicators
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Type: boolean
Scanner tolkens
STRING HANDLING LIBRARY
procedure clearsfunction len: (unknown)function len: (unknown)procedure copyprocedure copyfunction copy: (unknown)function copy: (unknown)procedure copyprocedure catfunction cat: (unknown)function cat: (unknown)function cat: (unknown)function cat: (unknown)function comp: (unknown)function comp: (unknown)function comp: (unknown)function comp: (unknown)function compp: (unknown)function indexp: (unknown)procedure extractfunction extract: (unknown)function extract: (unknown)procedure insertfunction insert: (unknown)function insert: (unknown)function insert: (unknown)function insert: (unknown)function words: (unknown)function words: (unknown)function extwords: (unknown)function extwords: (unknown)procedure extwordsprocedure clearsfunction len: (unknown)function len: (unknown)procedure copyprocedure copyfunction copy: (unknown)function copy: (unknown)procedure copyprocedure catfunction cat: (unknown)function cat: (unknown)function cat: (unknown)function cat: (unknown)function comp: (unknown)function comp: (unknown)function comp: (unknown)function comp: (unknown)function compp: (unknown)function indexp: (unknown)procedure extractfunction extract: (unknown)function extract: (unknown)procedure insertfunction insert: (unknown)function insert: (unknown)function insert: (unknown)function insert: (unknown)function words: (unknown)function words: (unknown)function extwords: (unknown)function extwords: (unknown)procedure extwordsSCANNER MODULE
EXTENDED FUNCTION LIBRARY
procedure listprocedure listprocedure writetimeprocedure writetimeprocedure writedateprocedure writedatefunction local: (unknown)procedure getenvfunction getenv: (unknown)procedure execprocedure execprocedure execwprocedure execwprocedure getcurfunction getcur: (unknown)procedure setcurprocedure setcurprocedure brknamprocedure brknamprocedure brknamprocedure maknamfunction maknam: (unknown)function maknam: (unknown)function maknam: (unknown)function maknam: (unknown)function maknam: (unknown)function maknam: (unknown)function maknam: (unknown)function maknam: (unknown)procedure fulnamfunction fulnam: (unknown)procedure getpgmfunction getpgm: (unknown)procedure getusrfunction getusr: (unknown)procedure makpthprocedure makpthprocedure filchrfunction optchr: (unknown)function pthchr: (unknown)Character Level Parsing Library
procedure openparprocedure closeparprocedure openfilprocedure opencommandprocedure closefilfunction endfil: (unknown)function endlin: (unknown)function chkchr: (unknown)procedure getchrprocedure skpspcprocedure getlinprocedure parlabprocedure parfilprocedure parwrdprocedure setfchprocedure parstrprocedure prterr| 1 | {****************************************************************************** |
| 2 | |
| 3 | PC - PASCAL COMPILER SHELL |
| 4 | |
| 5 | Copyright (C) 2001 S. A. Moore |
| 6 | |
| 7 | Written 4/01 |
| 8 | |
| 9 | PC is a Pascal compilation shell. It examines the file given it, and forms |
| 10 | a dependency tree by looking at all the files that appear in "uses" or |
| 11 | "joins" statements. Then, the dates and times are checked against the |
| 12 | object files, and components rebuilt as required. |
| 13 | The command line is: |
| 14 | |
| 15 | pc program [-option]... |
| 16 | |
| 17 | Options: |
| 18 | |
| 19 | -t or -tree - List the dependency tree. |
| 20 | |
| 21 | -a or -action - List the actions taken (commands performed) |
| 22 | |
| 23 | -d or -dry - Do not actually perform anything. Used with -action to get a |
| 24 | list of what is going to happen before actually running the |
| 25 | operation. |
| 26 | |
| 27 | -r or -rebuild - Treat all files as needing to be rebuilt. |
| 28 | |
| 29 | -el or -errorlimit=n - Passthrough option to limit errors. |
| 30 | |
| 31 | -nrf or -noreference - Passthrough option to remove reference checking. |
| 32 | |
| 33 | -u or -uses=path - Direct specification of uses path. |
| 34 | |
| 35 | Currently contains some Windows dependencies, which need to be removed: |
| 36 | |
| 37 | 1. Relys on directly outputting windows commands. |
| 38 | |
| 39 | 2. Relys on windows mode paths. |
| 40 | |
| 41 | Remaining "to do" items: |
| 42 | |
| 43 | 1. Implement packages. |
| 44 | |
| 45 | 2. Have pc check what type the target file is, and if a module, perform |
| 46 | a compile without a link. |
| 47 | |
| 48 | ******************************************************************************} |
| 49 | |
| 50 | program pc(output, command); |
| 51 | |
| 52 | joins |
| 53 | |
| 54 | { parser library } parse, |
| 55 | { os extentions } services, |
| 56 | { pascal scanner } scanner; |
| 57 | |
| 58 | uses |
| 59 | |
| 60 | { string library } strings; |
| 61 | |
| 62 | |
| 63 | { abort program } |
| 64 | label 99; |
| 65 | |
| 66 | const |
| 67 | |
| 68 | { name of base libary } serlib = 'psystem'; |
| 69 | { name of terminal library } trmlib = 'terminal'; |
| 70 | { name of graphical library } gralib = 'graphical'; |
| 71 | { libs that can be substituted for standard serial library } |
| 72 | iolibs = 'terminal graphical'; |
| 73 | { libs that run in a separate window } |
| 74 | gwlibs = 'gralib gmnlib'; |
| 75 | { maximum length of command line } cmdmax = 250; |
| 76 | { maximum length of filename } filmax = 1000; |
| 77 | { maximum size of input line } maxlin = 1000; |
| 78 | |
| 79 | type |
| 80 | |
| 81 | { index for filename } filinx = 1..filmax; |
| 82 | { filename } filnam = packed array [filinx] of char; |
| 83 | { index for text line } lininx = 1..maxlin; |
| 84 | { a text line } linbuf = packed array [lininx] of char; |
| 85 | { pointer to file entry } filept = ^filety; |
| 86 | { pointer to file linkage entry } fllptr = ^fillet; |
| 87 | { file information entry } |
| 88 | filety = record |
| 89 | |
| 90 | { filename } name: filnam; |
| 91 | { time of last modification } modify: integer; |
| 92 | { requires rebuilding } rebld: boolean; |
| 93 | { file is excluded or exists in an excluded directory } |
| 94 | excl: boolean; |
| 95 | { file contains code } code: boolean; |
| 96 | { next stack entry } stack: filept; |
| 97 | { linkage list } link: fllptr; |
| 98 | { placed in link list } list: boolean; |
| 99 | { is program/module } pgm: boolean; |
| 100 | { intermediate file entry } inte: filept; |
| 101 | { assembly file entry } asme: filept; |
| 102 | { object file entry } obje: filept; |
| 103 | { archive file entry } arce: filept; |
| 104 | { executable file entry } exec: filept; |
| 105 | { packaged within this module } pkg: filept |
| 106 | |
| 107 | end; |
| 108 | { file linkage entry } |
| 109 | fillet = record |
| 110 | |
| 111 | { link to used entry } ref: filept; |
| 112 | { next entry link } next: fllptr |
| 113 | |
| 114 | end; |
| 115 | { pointer to file list entry } lstptr = ^lstety; |
| 116 | { file list entry } |
| 117 | lstety = record |
| 118 | |
| 119 | { filename } name: pstring; |
| 120 | { next link } next: lstptr |
| 121 | |
| 122 | end; |
| 123 | { packaging entry } pkgptr = ^pkgety; |
| 124 | { library packing spec } |
| 125 | pkgety = record |
| 126 | |
| 127 | { name of root package } name: pstring; |
| 128 | { list of contained packages } lst: lstptr; |
| 129 | { next entry in list } next: pkgptr |
| 130 | |
| 131 | end; |
| 132 | { filename extention } ext = packed array [1..3] of char; |
| 133 | |
| 134 | var |
| 135 | |
| 136 | { handle for command parsing } cmdhan: parse.parhan; |
| 137 | { error holder } err: boolean; |
| 138 | { valid file characters } valfch: schar; |
| 139 | { file information stack } filstk: filept; |
| 140 | { target program name } prgnam: filnam; |
| 141 | { path components } p, n, e: filnam; |
| 142 | { path of module files } modpth: filnam; |
| 143 | { these are pc internal flags } |
| 144 | { verbose flag (also gets passed through) } |
| 145 | fverb: boolean; |
| 146 | { list dependency tree } ftree: boolean; |
| 147 | { list actions } fact: boolean; |
| 148 | { do not perform actions } fdry: boolean; |
| 149 | { rebuild all } frebld: boolean; |
| 150 | { generate documentation } fdoc: boolean; |
| 151 | { generate html documentation } fhtml: boolean; |
| 152 | { print help } fhelp: boolean; |
| 153 | { no graphical windows mode } fngwin: boolean; |
| 154 | { default to terminal mode } fdeftrm: boolean; |
| 155 | { default to graphical mode } fdefgra: boolean; |
| 156 | { compile for pint (interpreter) } fpint: boolean; |
| 157 | { compile for pmach (interpreter) } fpmach: boolean; |
| 158 | { compile for cmach (compiler) } fcmach: boolean; |
| 159 | { compile for package mode } fpack: boolean; |
| 160 | { compile for pgen mode (executable) } fpgen: boolean; |
| 161 | { these are "pass through" options, options meant for programs we execute } |
| 162 | { generate coff symbols } fsymcof: boolean; |
| 163 | { passthrough options: these have "set/not set indicators } |
| 164 | fprtlab, sprtlab: boolean; |
| 165 | flstcod, slstcod: boolean; |
| 166 | fchk, schk: boolean; |
| 167 | fprtlabdef, sprtlabdef: boolean; |
| 168 | fsourceset, ssourceset: boolean; |
| 169 | fvarblk, svarblk: boolean; |
| 170 | fexperror, sexperror: boolean; |
| 171 | fecholine, secholine: boolean; |
| 172 | flist, slist: boolean; |
| 173 | fbreakheap, sbreakheap: boolean; |
| 174 | frecycle, srecycle: boolean; |
| 175 | fchkoverflo, schkoverflo: boolean; |
| 176 | fchkreuse, schkreuse: boolean; |
| 177 | fchkundef, schkundef: boolean; |
| 178 | freference, sreference: boolean; |
| 179 | fiso7185, siso7185: boolean; |
| 180 | fprttables, sprttables: boolean; |
| 181 | fundestag, sundestag: boolean; |
| 182 | fchkvar, schkvar: boolean; |
| 183 | fdebug, sdebug: boolean; |
| 184 | fdebugflt, sdebugflt: boolean; |
| 185 | fdebugsrc, sdebugsrc: boolean; |
| 186 | fprtlex, sprtlex: boolean; |
| 187 | fprtdisplay, sprtdisplay: boolean; |
| 188 | flineinfo, slineinfo: boolean; |
| 189 | fmrklin, smrklin: boolean; |
| 190 | { error file passthrough } |
| 191 | errfil: filnam; |
| 192 | serrfil: boolean; |
| 193 | |
| 194 | { head entry pointer } hp: filept; |
| 195 | { link order list } lnklst: filnam; |
| 196 | { files to process count } filcnt: integer; |
| 197 | { file actions list } filact: fllptr; |
| 198 | { actions count } actcnt: integer; |
| 199 | { executive needs rebuilding } excrbl: boolean; |
| 200 | { program path } pgmpath: filnam; |
| 201 | { user path } usrpath: filnam; |
| 202 | { current path } curpath: filnam; |
| 203 | { target path } tarpath: filnam; |
| 204 | { temp filename holding } tmpnam: filnam; |
| 205 | { exclude list } exclude: lstptr; |
| 206 | { packaging list } package: pkgptr; |
| 207 | { a graphical window library exists } grawin: boolean; |
| 208 | { an alternate standard I/O library exists } |
| 209 | siolib: boolean; |
| 210 | { exit has error } errexit: boolean; |
| 211 | |
| 212 | procedure logfil(view fn: string; var hp: filept); forward; |
| 213 | |
| 214 | {****************************************************************************** |
| 215 | |
| 216 | Flag program error |
| 217 | |
| 218 | Outputs an error message, flags an error on exit, and exits the program. |
| 219 | Takes from one to 5 parameters, which are embedded with '%' markers. Each |
| 220 | parameters corresponds to the position of the mark in the first string. |
| 221 | |
| 222 | ******************************************************************************} |
| 223 | |
| 224 | procedure error(view es, s1, s2, s3, s4, s5: string); |
| 225 | |
| 226 | var i: integer; { string index } |
| 227 | c: integer; { parameter count } |
| 228 | |
| 229 | begin |
| 230 | |
| 231 | write('*** pc: Error: '); { output preamble } |
| 232 | i := 1; { set 1st string position } |
| 233 | c := 1; { set 1st parameter } |
| 234 | while i <= max(es) do begin |
| 235 | |
| 236 | if es[i] = '%' then begin |
| 237 | |
| 238 | case c of { parameter } |
| 239 | |
| 240 | 1: write(s1:*); |
| 241 | 2: write(s2:*); |
| 242 | 3: write(s3:*); |
| 243 | 4: write(s4:*); |
| 244 | 5: write(s5:*) |
| 245 | |
| 246 | end; |
| 247 | c := c+1 { next parameter } |
| 248 | |
| 249 | end else write(es[i]); |
| 250 | i := i+1 { next string character } |
| 251 | |
| 252 | end; |
| 253 | writeln; |
| 254 | errexit := true; { flag exit error } |
| 255 | goto 99 |
| 256 | |
| 257 | end; |
| 258 | |
| 259 | overload procedure error(view es: string); |
| 260 | begin error(es, '', '', '', '', '') end; |
| 261 | overload procedure error(view es, s1: string); |
| 262 | begin error(es, s1, '', '', '', '') end; |
| 263 | overload procedure error(view es, s1, s2: string); |
| 264 | begin error(es, s1, s2, '', '', '') end; |
| 265 | overload procedure error(view es, s1, s2, s3: string); |
| 266 | begin error(es, s1, s2, s3, '', '') end; |
| 267 | overload procedure error(view es, s1, s2, s3, s4: string); |
| 268 | begin error(es, s1, s2, s3, s4, '') end; |
| 269 | |
| 270 | {****************************************************************************** |
| 271 | |
| 272 | Check options |
| 273 | |
| 274 | Checks if a sequence of options is present in the input, and if so, parses and |
| 275 | processes them. An option is a '-' followed by the option identifier. |
| 276 | The identifier must be one of the valid options. Further processing may occur, |
| 277 | on input after the option, depending on the option specified (see the |
| 278 | handlers). Consult the operator's manual for full option details. |
| 279 | |
| 280 | ******************************************************************************} |
| 281 | |
| 282 | procedure paropt; |
| 283 | |
| 284 | var w: filnam; { word holder } |
| 285 | err: boolean; { error flag holding } |
| 286 | optfnd: boolean; { option found } |
| 287 | |
| 288 | { set true/false flag } |
| 289 | |
| 290 | procedure setflg(view a, n: string; var f, s: boolean); |
| 291 | |
| 292 | var ts: packed array [1..40] of char; { string holder } |
| 293 | |
| 294 | begin |
| 295 | |
| 296 | if compp(w, n) or compp(w, a) then begin |
| 297 | |
| 298 | f := true; { perform true } |
| 299 | s := true; { set this option found } |
| 300 | optfnd := true { set option found } |
| 301 | |
| 302 | end else begin { try false cases } |
| 303 | |
| 304 | copy(ts, 'n'); { form negative } |
| 305 | cat(ts, n); |
| 306 | if compp(w, ts) then begin |
| 307 | |
| 308 | f := false; { perform false } |
| 309 | s := true; { set this option found } |
| 310 | optfnd := true { set option found } |
| 311 | |
| 312 | end else begin |
| 313 | |
| 314 | copy(ts, 'n'); { form negative } |
| 315 | cat(ts, a); |
| 316 | if compp(w, ts) then begin |
| 317 | |
| 318 | f := false; { perform false } |
| 319 | s := true; { set this option found } |
| 320 | optfnd := true { set option found } |
| 321 | |
| 322 | end |
| 323 | |
| 324 | end |
| 325 | |
| 326 | end |
| 327 | |
| 328 | end; |
| 329 | |
| 330 | overload procedure setflg(view n: string; var f, s: boolean); |
| 331 | |
| 332 | begin |
| 333 | |
| 334 | setflg('', n, f, s) |
| 335 | |
| 336 | end; |
| 337 | |
| 338 | overload procedure setflg(view a, n: string; var f: boolean); |
| 339 | |
| 340 | var s: boolean; |
| 341 | |
| 342 | begin |
| 343 | |
| 344 | setflg(a, n, f, s) |
| 345 | |
| 346 | end; |
| 347 | |
| 348 | overload procedure setflg(view n: string; var f: boolean); |
| 349 | |
| 350 | begin |
| 351 | |
| 352 | setflg('', n, f) |
| 353 | |
| 354 | end; |
| 355 | |
| 356 | begin |
| 357 | |
| 358 | parse.skpspc(cmdhan); { skip spaces } |
| 359 | while parse.chkchr(cmdhan) = services.optchr do begin { parse option } |
| 360 | |
| 361 | optfnd := false; { set no option found } |
| 362 | parse.getchr(cmdhan); { skip option marker } |
| 363 | { allow double option character } |
| 364 | if parse.chkchr(cmdhan) = services.optchr then parse.getchr(cmdhan); |
| 365 | parse.parlab(cmdhan, w, err); { parse option label } |
| 366 | if err then error('Invalid option "%"', w); |
| 367 | { allow +/- suffix on option for compatibility } |
| 368 | if (parse.chkchr(cmdhan) = '+') or |
| 369 | (parse.chkchr(cmdhan) = '-') then parse.getchr(cmdhan); |
| 370 | setflg('v', 'verbose', fverb); { verbose mode } |
| 371 | setflg('t', 'tree', ftree); { list dependency tree } |
| 372 | setflg('a', 'action', fact); { list actions } |
| 373 | setflg('d', 'dry', fdry); { don't perform actions } |
| 374 | setflg('r', 'rebuild', frebld); { rebuild everything } |
| 375 | setflg('doc', 'document', fdoc); { generate documentation } |
| 376 | setflg('html', fhtml); { generate html documentation } |
| 377 | setflg('h', 'help', fhelp); { print help } |
| 378 | setflg('pint', fpint); { compile for pint (interpreter) } |
| 379 | setflg('pmach', fpmach); { compile for pmach (interpreter) } |
| 380 | setflg('cmach', fcmach); { compile for cmach (interpreter) } |
| 381 | setflg('package', fpack); { compile for package mode } |
| 382 | { note: pgen is the default, and so is a no-op } |
| 383 | setflg('pgen', fpgen); { compile for package mode } |
| 384 | { keep terminal window for graphical window application } |
| 385 | setflg('ktw', 'keepterminalwindow', fngwin); |
| 386 | setflg('sc', 'symcoff', fsymcof); { generate coff symbols } |
| 387 | setflg('dt', 'defaultterminal', fdeftrm); { default to terminal mode } |
| 388 | setflg('dg', 'defaultgraphical', fdefgra); { default to graphical mode } |
| 389 | { passthrough options for the compiler. Note most of these are the long |
| 390 | options so they don't conflict with pc short options. } |
| 391 | setflg('prtlab', fprtlab, sprtlab); |
| 392 | setflg('lstcod', flstcod, slstcod); |
| 393 | setflg('chk', fchk, schk); |
| 394 | setflg('prtlabdef', fprtlabdef, sprtlabdef); |
| 395 | setflg('sourceset', fsourceset, ssourceset); |
| 396 | setflg('varblk', fvarblk, svarblk); |
| 397 | setflg('experror', fexperror, sexperror); |
| 398 | setflg('echoline', fecholine, secholine); |
| 399 | setflg('l', 'list', flist, slist); |
| 400 | setflg('breakheap', fbreakheap, sbreakheap); |
| 401 | setflg('recycle', frecycle, srecycle); |
| 402 | setflg('o', 'chkoverflo', fchkoverflo, schkoverflo); |
| 403 | setflg('chkreuse', fchkreuse, schkreuse); |
| 404 | setflg('chkundef', fchkundef, schkundef); |
| 405 | setflg('reference', freference, sreference); |
| 406 | setflg('s', 'iso7185', fiso7185, siso7185); |
| 407 | setflg('prttables', fprttables, sprttables); |
| 408 | setflg('undestag', fundestag, sundestag); |
| 409 | setflg('chkvar', fchkvar, schkvar); |
| 410 | setflg('debug', fdebug, sdebug); |
| 411 | setflg('a', 'debugflt', fdebugflt, sdebugflt); |
| 412 | setflg('f', 'debugsrc', fdebugsrc, sdebugsrc); |
| 413 | setflg('prtlex', fprtlex, sprtlex); |
| 414 | setflg('prtdisplay', fprtdisplay, sprtdisplay); |
| 415 | setflg('lineinfo', flineinfo, slineinfo); |
| 416 | setflg('mrkasslin', fmrklin, smrklin); |
| 417 | { non-flag options } |
| 418 | if compp(w, 'modulepath') or |
| 419 | compp(w, 'mp') then begin |
| 420 | |
| 421 | optfnd := true; |
| 422 | parse.skpspc(cmdhan); { skip spaces } |
| 423 | if parse.chkchr(cmdhan) <> '=' then { should have '=' } |
| 424 | error('missing "="'); |
| 425 | parse.getchr(cmdhan); { skip '=' } |
| 426 | parse.parwrd(cmdhan, modpth, err); { get path } |
| 427 | if err then error('Invalid module path "%"', modpth) |
| 428 | |
| 429 | end; |
| 430 | { error file: passthrough to pcom only } |
| 431 | if compp(w, 'errfile') or compp(w, 'ef') then begin |
| 432 | |
| 433 | optfnd := true; |
| 434 | parse.skpspc(cmdhan); { skip spaces } |
| 435 | if parse.chkchr(cmdhan) <> '=' then { should have '=' } |
| 436 | error('missing "="'); |
| 437 | parse.getchr(cmdhan); { skip '=' } |
| 438 | if parse.chkchr(cmdhan) = '"' then |
| 439 | parse.parstr(cmdhan, errfil, err) |
| 440 | else |
| 441 | parse.parfil(cmdhan, errfil, false, err); |
| 442 | if err then error('Invalid error filename "%"', errfil); |
| 443 | serrfil := true |
| 444 | |
| 445 | end; |
| 446 | if not optfnd then error('No option found'); { no option found } |
| 447 | parse.skpspc(cmdhan) { skip spaces } |
| 448 | |
| 449 | end |
| 450 | |
| 451 | end; |
| 452 | |
| 453 | {****************************************************************************** |
| 454 | |
| 455 | Search file |
| 456 | |
| 457 | Searches for an existing file in the files stack. The extentions and path |
| 458 | are stripped for the comparision, which means that the first of duplicates is |
| 459 | used. This rule is based on the idea that like name files must be either |
| 460 | duplicates or errors, which with the requirement that file bodies match |
| 461 | their filenames is true. |
| 462 | |
| 463 | Returns the head entry pointer that is found. |
| 464 | |
| 465 | ******************************************************************************} |
| 466 | |
| 467 | function schfil(view fn: string) { filename } |
| 468 | : filept; { found status } |
| 469 | |
| 470 | var fnd: boolean; { return status holder } |
| 471 | fp: filept; { stack pointer } |
| 472 | p, n, e: filnam; { filespec components } |
| 473 | ns: filnam; { filename save } |
| 474 | hp: filept; { head entry pointer } |
| 475 | |
| 476 | begin |
| 477 | |
| 478 | fnd := false; { set not found } |
| 479 | services.brknam(fn, p, n, e); { break out name only } |
| 480 | copy(ns, n); { save } |
| 481 | fp := filstk; { index top of stack } |
| 482 | hp := nil; { set head not found } |
| 483 | while fp <> nil do begin { search stack } |
| 484 | |
| 485 | services.brknam(fp^.name, p, n, e); { break name } |
| 486 | if compp(ns, n) then hp := fp; { set filename found } |
| 487 | fp := fp^.stack { next stack entry } |
| 488 | |
| 489 | end; |
| 490 | |
| 491 | schfil := hp { return result } |
| 492 | |
| 493 | end; |
| 494 | |
| 495 | {****************************************************************************** |
| 496 | |
| 497 | Check file excluded |
| 498 | |
| 499 | Checks if the given file is a file in the exclude list, or is in an excluded |
| 500 | directory. |
| 501 | |
| 502 | ******************************************************************************} |
| 503 | |
| 504 | function chkexcl(view fn: string): boolean; |
| 505 | |
| 506 | var f: boolean; { match flag } |
| 507 | tn: filnam; { filename holder } |
| 508 | l: integer; |
| 509 | |
| 510 | function schexc(view fn: string): boolean; |
| 511 | |
| 512 | var fp: lstptr; { pointer for exclude list } |
| 513 | f: boolean; { found flag } |
| 514 | |
| 515 | begin |
| 516 | |
| 517 | f := false; { set not found } |
| 518 | fp := exclude; { index top of exclude list } |
| 519 | while fp <> nil do begin |
| 520 | |
| 521 | if compp(fp^.name^, fn) then begin { found name } |
| 522 | |
| 523 | f := true; { set found } |
| 524 | fp := nil { indicate stop } |
| 525 | |
| 526 | end else fp := fp^.next { next in list } |
| 527 | |
| 528 | end; |
| 529 | |
| 530 | schexc := f { return result } |
| 531 | |
| 532 | end; |
| 533 | |
| 534 | begin |
| 535 | |
| 536 | services.brknam(fn, p, n, e); { break down } |
| 537 | services.maknam(tn, p, n, ''); { remove extention } |
| 538 | f := schexc(tn); { search for the filename } |
| 539 | l := len(p); { check path ends in '/' } |
| 540 | if l > 0 then if p[l] = services.pthchr then p[l] := ' '; |
| 541 | if not f then f := schexc(p); { try search directory } |
| 542 | |
| 543 | chkexcl := f { return result } |
| 544 | |
| 545 | end; |
| 546 | |
| 547 | {****************************************************************************** |
| 548 | |
| 549 | Do list file |
| 550 | |
| 551 | Gets a file entry corresponding to the filename. Gets a filptr entry for the |
| 552 | indicated file, then reformats it into our entry type. Does not handle |
| 553 | wildcards. If there is no such file, nil is returned. |
| 554 | |
| 555 | ******************************************************************************} |
| 556 | |
| 557 | procedure dolist(view fn: string; { filename to look up } |
| 558 | var fp: filept); { entry to return } |
| 559 | |
| 560 | var l: services.filptr; { file entry pointer } |
| 561 | |
| 562 | begin |
| 563 | |
| 564 | fp := nil; { set no file } |
| 565 | services.list(fn, l); { get files list } |
| 566 | if l <> nil then begin { there is a file } |
| 567 | |
| 568 | if l^.next <> nil then |
| 569 | error('System fault'); { should not be more than one entry } |
| 570 | { translate entry } |
| 571 | new(fp); { get a new entry } |
| 572 | with fp^ do begin |
| 573 | |
| 574 | copy(fp^.name, fn); { place name } |
| 575 | modify := l^.modify; { place date } |
| 576 | rebld := false; { set no rebuild } |
| 577 | excl := false; { clear exclude } |
| 578 | code := false; { set no code } |
| 579 | stack := nil; { clear stack link } |
| 580 | link := nil; { clear link list } |
| 581 | list := false; { set not in link list } |
| 582 | pgm := false; { set not program file } |
| 583 | inte := nil; { set no intermediate file } |
| 584 | asme := nil; { set no assembly file } |
| 585 | obje := nil; { set no object file } |
| 586 | arce := nil; { set no archive file } |
| 587 | exec := nil; { set no exective } |
| 588 | pkg := nil { set no package file } |
| 589 | |
| 590 | end |
| 591 | |
| 592 | end |
| 593 | |
| 594 | end; |
| 595 | |
| 596 | {****************************************************************************** |
| 597 | |
| 598 | Find file in module path |
| 599 | |
| 600 | Finds the given file by the module path. If a module path name is found, that |
| 601 | name is returned with full path. If it is not found, or there is no module |
| 602 | path, the original name is returned. |
| 603 | |
| 604 | ******************************************************************************} |
| 605 | |
| 606 | procedure fndfilmod(var fn: string); |
| 607 | |
| 608 | var p, n, e: filnam; { path components } |
| 609 | pt: filnam; { uses path holder } |
| 610 | w: filnam; { single path holder } |
| 611 | fns: filnam; { trial filespec } |
| 612 | m: boolean; { match flag } |
| 613 | i: integer; |
| 614 | |
| 615 | begin |
| 616 | |
| 617 | services.brknam(fn, p, n, e); { break down filespec } |
| 618 | if modpth[1] <> ' ' then begin { module path is not empty } |
| 619 | |
| 620 | copy(pt, modpth); { copy module path } |
| 621 | m := false; { set no match } |
| 622 | repeat { try path components } |
| 623 | |
| 624 | { extract a single path from the module path } |
| 625 | i := indexp(pt, ':'); { find location of path divider } |
| 626 | if i = 0 then begin { only one path left, use the whole thing } |
| 627 | |
| 628 | copy(w, pt); { place } |
| 629 | clears(pt) { clear out the rest } |
| 630 | |
| 631 | end else begin { extract single path } |
| 632 | |
| 633 | extract(w, pt, 1, i-1); { get the path } |
| 634 | extract(pt, pt, i+1, len(pt)) { remove from module path } |
| 635 | |
| 636 | end; |
| 637 | services.maknam(fns, w, n, e); { try that path } |
| 638 | if exists(fns) then begin |
| 639 | |
| 640 | copy(fn, fns); { copy winning spec } |
| 641 | m := true { set match } |
| 642 | |
| 643 | end |
| 644 | |
| 645 | until (pt[1] = ' ') or m { until path is empty or matched } |
| 646 | |
| 647 | end |
| 648 | |
| 649 | end; |
| 650 | |
| 651 | |
| 652 | {****************************************************************************** |
| 653 | |
| 654 | Find file |
| 655 | |
| 656 | Finds the given file by the module path. If a module path name is found, that |
| 657 | name is returned with full path. If it is not found, or there is no module |
| 658 | path, the original name is returned. |
| 659 | |
| 660 | ******************************************************************************} |
| 661 | |
| 662 | procedure fndfil(var fn: string; obj: boolean); |
| 663 | |
| 664 | var p, n, e: filnam; { path components } |
| 665 | pt: filnam; { uses path holder } |
| 666 | w: filnam; { single path holder } |
| 667 | fns: filnam; { trial filespec } |
| 668 | m: boolean; { match flag } |
| 669 | i: integer; |
| 670 | |
| 671 | procedure makpth(view pn: string); |
| 672 | |
| 673 | begin |
| 674 | |
| 675 | services.maknam(fns, pn, n, 'pas'); { construct a name } |
| 676 | services.fulnam(fns); { rationalize } |
| 677 | if exists(fns) and not obj then begin |
| 678 | |
| 679 | copy(fn, fns); { copy winning spec } |
| 680 | m := true { set found } |
| 681 | |
| 682 | end else begin |
| 683 | |
| 684 | services.maknam(fns, pn, n, 'a'); { construct a name } |
| 685 | services.fulnam(fns); { rationalize } |
| 686 | if exists(fns) then begin |
| 687 | |
| 688 | copy(fn, fns); { copy winning spec } |
| 689 | m := true { set found } |
| 690 | |
| 691 | end else begin |
| 692 | |
| 693 | services.maknam(fns, pn, n, 'o'); { construct a name } |
| 694 | services.fulnam(fns); { rationalize } |
| 695 | if exists(fns) then begin |
| 696 | |
| 697 | copy(fn, fns); { copy winning spec } |
| 698 | m := true { set found } |
| 699 | |
| 700 | end |
| 701 | |
| 702 | end |
| 703 | |
| 704 | end |
| 705 | |
| 706 | end; |
| 707 | |
| 708 | begin |
| 709 | |
| 710 | services.brknam(fn, p, n, e); { break down filespec } |
| 711 | makpth(tarpath); { try target path } |
| 712 | if not m and (modpth[1] <> ' ') then begin { module path is not empty } |
| 713 | |
| 714 | copy(pt, modpth); { copy module path } |
| 715 | m := false; { set no match } |
| 716 | repeat { try path components } |
| 717 | |
| 718 | { extract a single path from the module path } |
| 719 | i := indexp(pt, ':'); { find location of path divider } |
| 720 | if i = 0 then begin { only one path left, use the whole thing } |
| 721 | |
| 722 | copy(w, pt); { place } |
| 723 | clears(pt) { clear out the rest } |
| 724 | |
| 725 | end else begin { extract single path } |
| 726 | |
| 727 | extract(w, pt, 1, i-1); { get the path } |
| 728 | extract(pt, pt, i+1, len(pt)) { remove from module path } |
| 729 | |
| 730 | end; |
| 731 | makpth(w) { try that path } |
| 732 | |
| 733 | until (pt[1] = ' ') or m { until path is empty or matched } |
| 734 | |
| 735 | end |
| 736 | |
| 737 | end; |
| 738 | |
| 739 | {****************************************************************************** |
| 740 | |
| 741 | Do uses/joins file |
| 742 | |
| 743 | Accepts the name of a Pascal file, complete with extention. searches for a |
| 744 | uses or joins statement in the source, then processes a log operation on each |
| 745 | file. Since this is a recursive call, all of the uses files downwards from the |
| 746 | file will be registered. We perform a search for each file being already in the |
| 747 | tree in order to prevent loops. |
| 748 | |
| 749 | The entries are chained to the current head entry. |
| 750 | |
| 751 | Also now checks if the file contains code. Code is classified as any variables, |
| 752 | fixed, procedures or functions. If a file contains none of these, then it can |
| 753 | be assumed to be a define only file, and can be skipped from the link order. |
| 754 | |
| 755 | ******************************************************************************} |
| 756 | |
| 757 | procedure douses(view fn: string; { filename to process } |
| 758 | fp: filept); { head entry } |
| 759 | |
| 760 | var f: scanner.fcbptr; { file control block } |
| 761 | t: scanner.tolken; { next tolken save } |
| 762 | w: filnam; { path holder } |
| 763 | hp: filept; { head entry pointer } |
| 764 | p: fllptr; { file linkage pointer } |
| 765 | |
| 766 | { skip forward to interesting tolken, while tracking in-code status } |
| 767 | |
| 768 | procedure skpsrc(view s: scanner.tlkset); |
| 769 | |
| 770 | var blkcnt: integer; { block nesting tracker } |
| 771 | |
| 772 | begin |
| 773 | |
| 774 | blkcnt := 0; { set no block level } |
| 775 | { skip } |
| 776 | while not (f^.nxttlk in s) do begin |
| 777 | |
| 778 | { perform block nest/unnest } |
| 779 | if f^.nxttlk = scanner.cbegin then blkcnt := blkcnt+1 { nest blocks } |
| 780 | { 'begin' is unambiguous, but 'end' has multiple uses, it can also appear |
| 781 | in a record. However, these are never declared inside a block. So we |
| 782 | just ignore attempts to go negative on block nesting. } |
| 783 | else if (f^.nxttlk = scanner.cend) and (blkcnt > 0) then |
| 784 | blkcnt := blkcnt-1 { denest } |
| 785 | { now, ANYTHING within an active begin..end block can be considered code. |
| 786 | We only have to do this because an empty block is required on a |
| 787 | module. } |
| 788 | else if blkcnt > 0 then fp^.code := true; |
| 789 | { Note that "var" can appear in two places, but they both imply code is |
| 790 | generated. } |
| 791 | if f^.nxttlk in [scanner.cvar, scanner.cfixed] then |
| 792 | fp^.code := true; { coding structure found } |
| 793 | scanner.gettlk(f) { get next tolken } |
| 794 | |
| 795 | end |
| 796 | |
| 797 | end; |
| 798 | |
| 799 | begin |
| 800 | |
| 801 | scanner.fansi := fiso7185; { set standard mode for scan } |
| 802 | scanner.opnscn(f, fn); { open scan instance } |
| 803 | { if it is a program, indicate } |
| 804 | if f^.nxttlk = scanner.cprogram then fp^.pgm := true; |
| 805 | { skip until file end or "uses" or "joins" } |
| 806 | skpsrc([scanner.cuses, scanner.cjoins, scanner.ceof]); |
| 807 | while (f^.nxttlk = scanner.cuses) or (f^.nxttlk = scanner.cjoins) do begin |
| 808 | |
| 809 | { we found it } |
| 810 | scanner.gettlk(f); { skip 'uses'/'joins' } |
| 811 | repeat { process 'uses' files } |
| 812 | |
| 813 | if f^.nxttlk <> scanner.cidentifier then { bad syntax } |
| 814 | error('Bad ''uses''/''joins'' syntax in %', fn); |
| 815 | copy(w, f^.nxtlab); { copy name } |
| 816 | fndfil(w, false); { find it } |
| 817 | logfil(w, hp); { log that } |
| 818 | { chain it to caller head entry } |
| 819 | new(p); { get a new link entry } |
| 820 | p^.ref := hp; { place link } |
| 821 | p^.next := fp^.link; { insert to link list } |
| 822 | fp^.link := p; |
| 823 | scanner.gettlk(f); { get next tolken } |
| 824 | t := f^.nxttlk; { save next tolken } |
| 825 | if f^.nxttlk = scanner.ccma then scanner.gettlk(f) { skip ',' } |
| 826 | |
| 827 | until t <> scanner.ccma; { until no more } |
| 828 | if f^.nxttlk <> scanner.cscn then { bad syntax } |
| 829 | error('Bad ''uses'' syntax in %', fn); |
| 830 | { find next file end or "uses" or "joins" } |
| 831 | skpsrc([scanner.cuses, scanner.cjoins, scanner.ceof]) |
| 832 | |
| 833 | end; |
| 834 | skpsrc([scanner.ceof]); { skip until file end } |
| 835 | scanner.clsscn(f) { close scan instance } |
| 836 | |
| 837 | end; |
| 838 | |
| 839 | {****************************************************************************** |
| 840 | |
| 841 | Log source file |
| 842 | |
| 843 | Creates a file entry for the given file, and stacks that. The following |
| 844 | components are found and logged for the given filename: |
| 845 | |
| 846 | file.pas - The Pascal source. |
| 847 | file.asm - The assembly language source. |
| 848 | file.obj - The object. |
| 849 | file.sym - The symbols. |
| 850 | |
| 851 | The Pascal source must be found, or an error results. This is because even an |
| 852 | assembly file requires a "front end" description file. |
| 853 | This becomes the "head" file. Then, the other components are serached for, |
| 854 | and chained to the head entry as found. |
| 855 | Finally, the Pascal source file is examined for any "uses" files (using our |
| 856 | portable scanner), and each of the uses files are logged as well. |
| 857 | |
| 858 | ******************************************************************************} |
| 859 | |
| 860 | procedure logfil(view fn: string; { filename to process } |
| 861 | var hp: filept); { head entry found } |
| 862 | |
| 863 | var p, n, e: filnam; { path components } |
| 864 | fp: filept; { file entry pointer } |
| 865 | fns: filnam; { holder for filename } |
| 866 | |
| 867 | begin |
| 868 | |
| 869 | copy(fns, fn); { create modifable copy of name } |
| 870 | { check we have already logged this file } |
| 871 | hp := schfil(fn); |
| 872 | if hp = nil then begin { nope, process } |
| 873 | |
| 874 | { do the four component files } |
| 875 | services.brknam(fns, p, n, e); { add Pascal extention } |
| 876 | services.maknam(fns, p, n, 'pas'); |
| 877 | dolist(fns, hp); |
| 878 | if hp = nil then{ missing source } |
| 879 | error('missing source file %', fns); |
| 880 | hp^.excl := chkexcl(fn); { check exists in exclude } |
| 881 | services.brknam(fns, p, n, e); { add intermediate extention } |
| 882 | services.maknam(fns, p, n, 'p6'); |
| 883 | dolist(fns, fp); |
| 884 | hp^.inte := fp; { place link } |
| 885 | services.brknam(fns, p, n, e); { add assembly extention } |
| 886 | services.maknam(fns, p, n, 'asm'); |
| 887 | dolist(fns, fp); |
| 888 | hp^.asme := fp; { place link } |
| 889 | services.brknam(fns, p, n, e); { add object extention } |
| 890 | services.maknam(fns, p, n, 'o'); |
| 891 | dolist(fns, fp); |
| 892 | hp^.obje := fp; { place link } |
| 893 | services.brknam(fns, p, n, e); { add archive extention } |
| 894 | services.maknam(fns, p, n, 'a'); |
| 895 | dolist(fns, fp); |
| 896 | hp^.arce := fp; { place link } |
| 897 | services.brknam(fns, p, n, e); { add exec extention (none) } |
| 898 | services.maknam(fns, p, n, ''); |
| 899 | dolist(fns, fp); |
| 900 | hp^.arce := fp; { place link } |
| 901 | { place head on stack } |
| 902 | hp^.stack := filstk; |
| 903 | filstk := hp; |
| 904 | services.brknam(fns, p, n, e); { add Pascal extention } |
| 905 | services.maknam(fns, p, n, 'pas'); |
| 906 | filcnt := filcnt+1; { count head files } |
| 907 | douses(fns, hp) { process any uses files under } |
| 908 | |
| 909 | end |
| 910 | |
| 911 | end; |
| 912 | |
| 913 | {****************************************************************************** |
| 914 | |
| 915 | Write file entry |
| 916 | |
| 917 | Writes out the file name entry, followed by the time of modification and |
| 918 | rebuild status. |
| 919 | |
| 920 | ******************************************************************************} |
| 921 | |
| 922 | procedure wrtfil(fp: filept); { entry to write } |
| 923 | |
| 924 | begin |
| 925 | |
| 926 | { should find max length of filenames } |
| 927 | write(fp^.name:*); { output filename } |
| 928 | write(' '); { separate } |
| 929 | services.writedate(services.local(fp^.modify)); { output date/time of modification } |
| 930 | write(' '); { separate } |
| 931 | services.writetime(services.local(fp^.modify)); |
| 932 | write(' '); { separate } |
| 933 | if fp^.rebld then write(' Rebuild') |
| 934 | else write(' No rebuild'); |
| 935 | if fp^.excl then write(' Exclude') |
| 936 | else write(' No exclude'); |
| 937 | if fp^.pgm then write(' Is a program') |
| 938 | else write(' Is a module'); |
| 939 | if fp^.code then write(' Contains code') |
| 940 | else write(' Contains no code'); |
| 941 | writeln |
| 942 | |
| 943 | end; |
| 944 | |
| 945 | {****************************************************************************** |
| 946 | |
| 947 | Print discovered file tree |
| 948 | |
| 949 | Prints the complete and formatted contents of the dependency tree. |
| 950 | |
| 951 | ******************************************************************************} |
| 952 | |
| 953 | procedure prtree; |
| 954 | |
| 955 | var fp: filept; { pointers for file elements } |
| 956 | rp: fllptr; { reference pointer } |
| 957 | p, n, e: filnam; { path components } |
| 958 | fn: filnam; { filename holder } |
| 959 | |
| 960 | begin |
| 961 | |
| 962 | writeln; |
| 963 | write('Dependency tree for '); |
| 964 | write(prgnam:*); |
| 965 | writeln; |
| 966 | fp := filstk; { index top of stack } |
| 967 | while fp <> nil do begin { print entries } |
| 968 | |
| 969 | writeln; |
| 970 | writeln('Pascal module:'); |
| 971 | writeln; |
| 972 | wrtfil(fp); { output head entry } |
| 973 | if (fp^.inte <> nil) or (fp^.asme <> nil) or (fp^.obje <> nil) or |
| 974 | (fp^.arce <> nil) then begin |
| 975 | |
| 976 | writeln; |
| 977 | writeln(' Components:'); |
| 978 | writeln; |
| 979 | if fp^.inte <> nil then begin |
| 980 | |
| 981 | write(' (intermediate) '); { tab out } |
| 982 | wrtfil(fp^.inte) { print entry } |
| 983 | |
| 984 | end; |
| 985 | if fp^.asme <> nil then begin |
| 986 | |
| 987 | write(' (assembly) '); { tab out } |
| 988 | wrtfil(fp^.asme) { print entry } |
| 989 | |
| 990 | end; |
| 991 | if fp^.obje <> nil then begin |
| 992 | |
| 993 | write(' (object) '); { tab out } |
| 994 | wrtfil(fp^.obje) { print entry } |
| 995 | |
| 996 | end; |
| 997 | if fp^.arce <> nil then begin |
| 998 | |
| 999 | write(' (archive) '); { tab out } |
| 1000 | wrtfil(fp^.arce) { print entry } |
| 1001 | |
| 1002 | end; |
| 1003 | if fp^.exec <> nil then begin |
| 1004 | |
| 1005 | write(' (executive) '); { tab out } |
| 1006 | wrtfil(fp^.exec) { print entry } |
| 1007 | |
| 1008 | end |
| 1009 | |
| 1010 | end; |
| 1011 | rp := fp^.link; { index top linkage } |
| 1012 | if rp <> nil then begin { announce } |
| 1013 | |
| 1014 | writeln; |
| 1015 | writeln(' References:'); |
| 1016 | writeln; |
| 1017 | write(' '); |
| 1018 | while rp <> nil do begin { traverse references } |
| 1019 | |
| 1020 | copy(fn, rp^.ref^.name); { copy name } |
| 1021 | services.brknam(fn, p, n, e); { remake without path or extention } |
| 1022 | services.maknam(fn, '', n, ''); |
| 1023 | write(output, fn:*); |
| 1024 | if rp^.next <> nil then write(','); |
| 1025 | rp := rp^.next { next entry } |
| 1026 | |
| 1027 | end; |
| 1028 | writeln |
| 1029 | |
| 1030 | end; |
| 1031 | if fp^.pkg <> nil then begin { its a packed file } |
| 1032 | |
| 1033 | writeln; |
| 1034 | writeln(' Is a component of package: '); |
| 1035 | writeln; |
| 1036 | write(' '); |
| 1037 | wrtfil(fp^.pkg) |
| 1038 | |
| 1039 | end; |
| 1040 | fp := fp^.stack { next in stack } |
| 1041 | |
| 1042 | end; |
| 1043 | writeln |
| 1044 | |
| 1045 | end; |
| 1046 | |
| 1047 | {****************************************************************************** |
| 1048 | |
| 1049 | Dump package list |
| 1050 | |
| 1051 | Dumps the contents of the package list. A diagnostic. |
| 1052 | |
| 1053 | ******************************************************************************} |
| 1054 | |
| 1055 | procedure dmppkg; |
| 1056 | |
| 1057 | var pp: pkgptr; { pointer for packages } |
| 1058 | lp: lstptr; { pointer for file entries } |
| 1059 | |
| 1060 | begin |
| 1061 | |
| 1062 | writeln('Packages:'); |
| 1063 | writeln; |
| 1064 | pp := package; { index top of package list } |
| 1065 | while pp <> nil do begin { traverse package list } |
| 1066 | |
| 1067 | writeln('Package: ', pp^.name^, ' Contents: '); |
| 1068 | lp := pp^.lst; { index top of file list } |
| 1069 | while lp <> nil do begin { traverse files list } |
| 1070 | |
| 1071 | writeln(' ', lp^.name^); |
| 1072 | lp := lp^.next { link next item in list } |
| 1073 | |
| 1074 | end; |
| 1075 | pp := pp^.next { next item in package list } |
| 1076 | |
| 1077 | end |
| 1078 | |
| 1079 | end; |
| 1080 | |
| 1081 | {****************************************************************************** |
| 1082 | |
| 1083 | Find or insert standard library |
| 1084 | |
| 1085 | Because every completed binary must have a standard library at the front, |
| 1086 | we check if one exists. If not, then we choose a default, as determined by the |
| 1087 | options set. |
| 1088 | |
| 1089 | ******************************************************************************} |
| 1090 | |
| 1091 | procedure stdlib; |
| 1092 | |
| 1093 | var defnam: filnam; { name for default library } |
| 1094 | fp: filept; { file pointer } |
| 1095 | |
| 1096 | { find if files list contains any i/o standard lib } |
| 1097 | |
| 1098 | procedure schsio; |
| 1099 | |
| 1100 | var w: integer; { total number of libraries } |
| 1101 | l: filnam; { library name } |
| 1102 | i: integer; { index } |
| 1103 | |
| 1104 | begin |
| 1105 | |
| 1106 | siolib := false; { set no standard I/O libraries } |
| 1107 | w := words(iolibs); { find the number of standard I/O libraries to find } |
| 1108 | for i := 1 to w do begin { search libraries } |
| 1109 | |
| 1110 | extwords(l, iolibs, i, i); { get library name } |
| 1111 | { search for that and set true if found } |
| 1112 | if schfil(l) <> nil then siolib := true |
| 1113 | |
| 1114 | end |
| 1115 | |
| 1116 | end; |
| 1117 | |
| 1118 | { find if files list contains any graphics windowing lib } |
| 1119 | |
| 1120 | procedure schgwn; |
| 1121 | |
| 1122 | var w: integer; { total number of libraries } |
| 1123 | l: filnam; { library name } |
| 1124 | i: integer; { index } |
| 1125 | |
| 1126 | begin |
| 1127 | |
| 1128 | grawin := false; { set no graphical windowed I/O libraries } |
| 1129 | { find the number of graphical windowed I/O libraries to find } |
| 1130 | w := words(gwlibs); |
| 1131 | for i := 1 to w do begin { search libraries } |
| 1132 | |
| 1133 | extwords(l, gwlibs, i, i); { get library name } |
| 1134 | { search for that and set true if found } |
| 1135 | if schfil(l) <> nil then grawin := true |
| 1136 | |
| 1137 | end |
| 1138 | |
| 1139 | end; |
| 1140 | |
| 1141 | begin |
| 1142 | |
| 1143 | schsio; { find if target already specifies a standard library } |
| 1144 | schgwn; { find if target specifies a graphical windowed library } |
| 1145 | if not siolib then begin { no standard library specified } |
| 1146 | |
| 1147 | { find default library } |
| 1148 | if fdefgra then copy(defnam, gralib) |
| 1149 | else if fdeftrm then copy(defnam, trmlib) |
| 1150 | else copy(defnam, serlib); |
| 1151 | fndfil(defnam, false); |
| 1152 | if not exists(defnam) then { not found } |
| 1153 | error('Support module not found %', defnam); |
| 1154 | logfil(defnam, fp) { log the library } |
| 1155 | |
| 1156 | end |
| 1157 | |
| 1158 | end; |
| 1159 | |
| 1160 | {****************************************************************************** |
| 1161 | |
| 1162 | Find package lists |
| 1163 | |
| 1164 | Finds the package links in the file list. Each file in the files stack is |
| 1165 | checked against the package list. If a referenced file is found inside a |
| 1166 | package, then then we check if the package file exists in the files list. |
| 1167 | If not, we then copy the package file from the package list to the files |
| 1168 | list. Then, we place a package link from the referencing file to the package |
| 1169 | file in the list. |
| 1170 | |
| 1171 | ******************************************************************************} |
| 1172 | |
| 1173 | procedure fndpkg; |
| 1174 | |
| 1175 | { check if name is contained in a package in the files list } |
| 1176 | |
| 1177 | function inpkg(view s: string): boolean; |
| 1178 | |
| 1179 | var m: boolean; { found flag } |
| 1180 | pp: pkgptr; { pointer for packages } |
| 1181 | |
| 1182 | function schpkg(lp: lstptr; view s: string): boolean; |
| 1183 | |
| 1184 | var m: boolean; { match flag } |
| 1185 | |
| 1186 | begin |
| 1187 | |
| 1188 | m := false; { set no match } |
| 1189 | while lp <> nil do begin |
| 1190 | |
| 1191 | if compp(lp^.name^, s) then m := true; { found } |
| 1192 | lp := lp^.next { next entry } |
| 1193 | |
| 1194 | end; |
| 1195 | |
| 1196 | schpkg := m { return result } |
| 1197 | |
| 1198 | end; |
| 1199 | |
| 1200 | begin |
| 1201 | |
| 1202 | m := false; { set no match } |
| 1203 | pp := package; { index top of package list } |
| 1204 | while pp <> nil do begin { traverse package list } |
| 1205 | |
| 1206 | if schpkg(pp^.lst, s) then if schfil(pp^.name^) <> nil then m := true; |
| 1207 | pp := pp^.next { next package } |
| 1208 | |
| 1209 | end; |
| 1210 | |
| 1211 | inpkg := m { return match } |
| 1212 | |
| 1213 | end; |
| 1214 | |
| 1215 | { add any required missing packages by reference } |
| 1216 | |
| 1217 | procedure addpkg; |
| 1218 | |
| 1219 | var pp: pkgptr; { pointer for packages } |
| 1220 | lp: lstptr; { pointer for file entries } |
| 1221 | fp: filept; { pointer to found entry } |
| 1222 | pf: filept; { package file found } |
| 1223 | p, n, e: filnam; { path components } |
| 1224 | fn: filnam; { extended name } |
| 1225 | logged: boolean; { a new file was logged in this relaxation pass } |
| 1226 | |
| 1227 | begin |
| 1228 | |
| 1229 | repeat { relaxation } |
| 1230 | |
| 1231 | logged := false; { set no log occurred } |
| 1232 | pp := package; { index top of package list } |
| 1233 | while pp <> nil do begin { traverse package list } |
| 1234 | |
| 1235 | lp := pp^.lst; { index top of file list } |
| 1236 | while lp <> nil do begin { traverse files list } |
| 1237 | |
| 1238 | fp := schfil(lp^.name^); { find matching entry in files list } |
| 1239 | if fp <> nil then begin { found a match } |
| 1240 | |
| 1241 | if not inpkg(lp^.name^) then |
| 1242 | begin { File does not already exist in another, or the same |
| 1243 | package. } |
| 1244 | |
| 1245 | { We have extend this with .pas. I don't think that any other |
| 1246 | extention would work downstream in any case. } |
| 1247 | services.brknam(pp^.name^, p, n, e); { break down filespec } |
| 1248 | services.maknam(fn, p, n, 'pas'); |
| 1249 | logfil(fn, pf); { log that } |
| 1250 | logged := true { set new log } |
| 1251 | |
| 1252 | end |
| 1253 | |
| 1254 | end; |
| 1255 | lp := lp^.next { link next item in list } |
| 1256 | |
| 1257 | end; |
| 1258 | pp := pp^.next { next item in package list } |
| 1259 | |
| 1260 | end |
| 1261 | |
| 1262 | until not logged { until no new entries } |
| 1263 | |
| 1264 | end; |
| 1265 | |
| 1266 | { link package references to their packages } |
| 1267 | |
| 1268 | procedure lnkpkg; |
| 1269 | |
| 1270 | var pp: pkgptr; { pointer for packages } |
| 1271 | lp: lstptr; { pointer for file entries } |
| 1272 | fp: filept; { pointer to found entry } |
| 1273 | pnp, pnn, pne: filnam; { path components for package element } |
| 1274 | fnp, fnn, fne: filnam; { path components for package element } |
| 1275 | cp: filept; { containing package in files list } |
| 1276 | |
| 1277 | begin |
| 1278 | |
| 1279 | fp := filstk; { index top of files list } |
| 1280 | while fp <> nil do begin { traverse } |
| 1281 | |
| 1282 | services.brknam(fp^.name, fnp, fnn, fne); { break filename to components } |
| 1283 | pp := package; { index top of package list } |
| 1284 | while pp <> nil do begin { traverse package list } |
| 1285 | |
| 1286 | cp := schfil(pp^.name^); { find this package name in files list } |
| 1287 | if cp <> nil then begin { package is in files list } |
| 1288 | |
| 1289 | lp := pp^.lst; { index top of file list } |
| 1290 | while lp <> nil do begin { traverse files list } |
| 1291 | |
| 1292 | { break filename to components } |
| 1293 | services.brknam(lp^.name^, pnp, pnn, pne); |
| 1294 | if compp(pnn, fnn) then { file contained in package } |
| 1295 | fp^.pkg := cp; { link file to containing package file } |
| 1296 | lp := lp^.next { link next item in list } |
| 1297 | |
| 1298 | end |
| 1299 | |
| 1300 | end; |
| 1301 | pp := pp^.next { next item in package list } |
| 1302 | |
| 1303 | end; |
| 1304 | fp := fp^.stack { next in stack } |
| 1305 | |
| 1306 | end |
| 1307 | |
| 1308 | end; |
| 1309 | |
| 1310 | begin { fndpkg } |
| 1311 | |
| 1312 | addpkg; { add required packages } |
| 1313 | lnkpkg { link to used packages } |
| 1314 | |
| 1315 | end; |
| 1316 | |
| 1317 | {****************************************************************************** |
| 1318 | |
| 1319 | Find link order |
| 1320 | |
| 1321 | Discovers the link order. First, we search for all entries that don't reference |
| 1322 | other modules (the leaf modules). These are placed in the link list, in stack |
| 1323 | order, and marked as in the list. The stack is upside down from the root |
| 1324 | program, so this tends to, but does not allways, result in the bottom most |
| 1325 | references appearing first. |
| 1326 | |
| 1327 | Second, we successively sweep for entries whose referenced modules are |
| 1328 | themselves listed. These are also marked listed, so N passes can output the |
| 1329 | entire tree. |
| 1330 | |
| 1331 | When a pass is performed that does not result in any new files becoming listed, |
| 1332 | then either the stack is empty, or the entries remaining form a cycle, or |
| 1333 | loop of mutual references. Since this is not at the present an error, we output |
| 1334 | an information message, then we output the top of the list and continue the |
| 1335 | entire algorithim until the stack is empty. |
| 1336 | |
| 1337 | We treat .o and .a files differently. .o files are assumed to be Pascaline |
| 1338 | startup compliant. .a files are assumed to be C/assembly compliant. The .a |
| 1339 | files appear after the .o files for that reason. If .a files containing |
| 1340 | Pascaline code appear, we must establish a method to indicate that they are |
| 1341 | also Pascaline compliant. |
| 1342 | |
| 1343 | ******************************************************************************} |
| 1344 | |
| 1345 | procedure fndlnk; |
| 1346 | |
| 1347 | var rescnt: integer; { resolved file count } |
| 1348 | ressav: integer; { resolved count save } |
| 1349 | cycwrn: boolean; { cyclic warning output } |
| 1350 | filacts: fllptr; { file action list save } |
| 1351 | p: fllptr; { file action pointer } |
| 1352 | lnklsto: filnam; { .o objects list } |
| 1353 | loi: integer; { .o output index } |
| 1354 | lnklsta: filnam; { .a objects list } |
| 1355 | lai: integer; { .a output index } |
| 1356 | |
| 1357 | { place output character } |
| 1358 | |
| 1359 | procedure putchr(var l: string; var i: integer; c: char); |
| 1360 | |
| 1361 | begin |
| 1362 | |
| 1363 | if i > filmax then { overflow } |
| 1364 | error('link list too long'); |
| 1365 | l[i] := c; { place character } |
| 1366 | i := i+1 |
| 1367 | |
| 1368 | end; |
| 1369 | |
| 1370 | { place filename in list } |
| 1371 | |
| 1372 | procedure plcfil(view fn: string); |
| 1373 | |
| 1374 | var p, n, e: filnam; { path components } |
| 1375 | fns: filnam; { save for name } |
| 1376 | i: integer; { index for name } |
| 1377 | |
| 1378 | begin |
| 1379 | |
| 1380 | { if interpreting, insert .intermediate extension} |
| 1381 | if fpint or fpmach or fcmach or fpack then begin |
| 1382 | |
| 1383 | services.brknam(fn, p, n, e); { break down name } |
| 1384 | services.maknam(fns, p, n, 'p6'); { remake } |
| 1385 | { place name in link list } |
| 1386 | for i := 1 to len(fns) do putchr(lnklsto, loi, fns[i]); |
| 1387 | putchr(lnklsto, loi, ' ') { place separator } |
| 1388 | |
| 1389 | end else begin |
| 1390 | |
| 1391 | { try .a extension } |
| 1392 | services.brknam(fn, p, n, e); { break down name } |
| 1393 | services.maknam(fns, p, n, 'a'); { remake } |
| 1394 | if exists(fns) then begin |
| 1395 | |
| 1396 | { place name in link list } |
| 1397 | for i := 1 to len(fns) do putchr(lnklsta, lai, fns[i]); |
| 1398 | putchr(lnklsta, lai, ' ') { place separator } |
| 1399 | |
| 1400 | end else begin |
| 1401 | |
| 1402 | { place .o extension } |
| 1403 | services.brknam(fn, p, n, e); { break down name } |
| 1404 | services.maknam(fns, p, n, 'o'); { remake } |
| 1405 | { place name in link list } |
| 1406 | for i := 1 to len(fns) do putchr(lnklsto, loi, fns[i]); |
| 1407 | putchr(lnklsto, loi, ' ') { place separator } |
| 1408 | |
| 1409 | end |
| 1410 | |
| 1411 | end |
| 1412 | |
| 1413 | end; |
| 1414 | |
| 1415 | { place file entry to list } |
| 1416 | |
| 1417 | procedure plcety(fp: filept); { file entry to place } |
| 1418 | |
| 1419 | var p: fllptr; |
| 1420 | |
| 1421 | begin |
| 1422 | |
| 1423 | if fp^.code and (fp^.pkg = nil) then { contains code, not in a package } |
| 1424 | plcfil(fp^.name); { place name in list } |
| 1425 | fp^.list := true; { set listed } |
| 1426 | new(p); { get list entry } |
| 1427 | p^.ref := fp; { index head file } |
| 1428 | p^.next := filact; { push to list } |
| 1429 | filact := p; |
| 1430 | rescnt := rescnt+1 { count listed entry } |
| 1431 | |
| 1432 | end; |
| 1433 | |
| 1434 | { search for standard I/O modules } |
| 1435 | |
| 1436 | procedure schstdio; |
| 1437 | |
| 1438 | var fp: filept; { pointer for files stack } |
| 1439 | |
| 1440 | { find name is in list } |
| 1441 | |
| 1442 | function inlist(view m, l: string): boolean; |
| 1443 | |
| 1444 | var i: integer; { list index } |
| 1445 | f: boolean; { match flag } |
| 1446 | w: filnam; { word from list } |
| 1447 | p, n, e: filnam; { filename components } |
| 1448 | |
| 1449 | begin |
| 1450 | |
| 1451 | services.brknam(m, p, n, e); { strip name off } |
| 1452 | f := false; { set no match } |
| 1453 | for i := 1 to words(l) do begin { for each list word } |
| 1454 | |
| 1455 | extwords(w, l, i, i); { get the current word } |
| 1456 | if compp(n, w) then f := true { set found } |
| 1457 | |
| 1458 | end; |
| 1459 | |
| 1460 | inlist := f { return result } |
| 1461 | |
| 1462 | end; |
| 1463 | |
| 1464 | begin |
| 1465 | |
| 1466 | fp := filstk; { index the top of stack } |
| 1467 | while fp <> nil do begin { traverse } |
| 1468 | |
| 1469 | { look for entries with no references and not listed } |
| 1470 | if inlist(fp^.name, iolibs) and not fp^.list then plcety(fp); { found } |
| 1471 | fp := fp^.stack { next on stack } |
| 1472 | |
| 1473 | end |
| 1474 | |
| 1475 | end; |
| 1476 | |
| 1477 | { search for leaves } |
| 1478 | |
| 1479 | procedure schleaf; |
| 1480 | |
| 1481 | var fp: filept; { pointer for files stack } |
| 1482 | |
| 1483 | begin |
| 1484 | |
| 1485 | fp := filstk; { index the top of stack } |
| 1486 | while fp <> nil do begin { traverse } |
| 1487 | |
| 1488 | { look for entries with no references and not listed } |
| 1489 | if (fp^.link = nil) and not fp^.list then plcety(fp); { found } |
| 1490 | fp := fp^.stack { next on stack } |
| 1491 | |
| 1492 | end |
| 1493 | |
| 1494 | end; |
| 1495 | |
| 1496 | { check entry is resolved } |
| 1497 | |
| 1498 | function resvd(p: fllptr) { entry to check resolved } |
| 1499 | : boolean; { resolved status } |
| 1500 | |
| 1501 | var r: boolean; { resolved flag } |
| 1502 | |
| 1503 | begin |
| 1504 | |
| 1505 | r := true; { set resolved } |
| 1506 | while p <> nil do begin { traverse } |
| 1507 | |
| 1508 | if not p^.ref^.list then r := false; { not resolved } |
| 1509 | p := p^.next { link next } |
| 1510 | |
| 1511 | end; |
| 1512 | resvd := r { return result } |
| 1513 | |
| 1514 | end; |
| 1515 | |
| 1516 | { search for resolved entries } |
| 1517 | |
| 1518 | procedure schres; { entry was listed } |
| 1519 | |
| 1520 | var fp: filept; { pointer for files stack } |
| 1521 | |
| 1522 | begin |
| 1523 | |
| 1524 | fp := filstk; { index the top of stack } |
| 1525 | while fp <> nil do begin { traverse } |
| 1526 | |
| 1527 | { look for entries that are resolved and not listed } |
| 1528 | if resvd(fp^.link) and not fp^.list then plcety(fp); { found } |
| 1529 | fp := fp^.stack { next on stack } |
| 1530 | |
| 1531 | end |
| 1532 | |
| 1533 | end; |
| 1534 | |
| 1535 | { search for any unlisted entry } |
| 1536 | |
| 1537 | procedure schnls; { entry was listed } |
| 1538 | |
| 1539 | var fp: filept; { pointer for files stack } |
| 1540 | |
| 1541 | begin |
| 1542 | |
| 1543 | fp := filstk; { index the top of stack } |
| 1544 | while fp <> nil do begin { traverse } |
| 1545 | |
| 1546 | { look for entries that are resolved and not listed } |
| 1547 | if not fp^.list then plcety(fp); { found } |
| 1548 | fp := fp^.stack { next on stack } |
| 1549 | |
| 1550 | end |
| 1551 | |
| 1552 | end; |
| 1553 | |
| 1554 | begin |
| 1555 | |
| 1556 | clears(lnklsto); { clear the output lists } |
| 1557 | clears(lnklsta); |
| 1558 | loi := 1; { index 1st character } |
| 1559 | lai := 1; |
| 1560 | rescnt := 0; { set no files resolved } |
| 1561 | cycwrn := false; { set no cyclic warning output } |
| 1562 | schstdio; { put standard I/O at the head of the list } |
| 1563 | schleaf; { toss in the leaves } |
| 1564 | while rescnt < filcnt do begin { while files remain unresolved } |
| 1565 | |
| 1566 | ressav := rescnt; { save counter for change check } |
| 1567 | schres; { search for resolved entries } |
| 1568 | if ressav = rescnt then begin { stuck on cyclic entries } |
| 1569 | |
| 1570 | if fverb and not cycwrn then begin { announce } |
| 1571 | |
| 1572 | writeln; |
| 1573 | writeln('Cycle was found in ''uses'' declarations'); |
| 1574 | writeln; |
| 1575 | cycwrn := true { set we warned of cyclic } |
| 1576 | |
| 1577 | end; |
| 1578 | schnls { throw out the first unlisted entry } |
| 1579 | |
| 1580 | end |
| 1581 | |
| 1582 | end; |
| 1583 | if len(lnklsto)+len(lnklsta)+1 > filmax then { overflow } |
| 1584 | error('link list too long'); |
| 1585 | copy(lnklst, lnklsto); { place .o files } |
| 1586 | insert(lnklst, lnklsta, len(lnklsto)+2); { place .a files at end } |
| 1587 | { now we need to reverse the order of the action list } |
| 1588 | filacts := filact; { get the list } |
| 1589 | filact := nil; { clear } |
| 1590 | while filacts <> nil do begin { entire list } |
| 1591 | |
| 1592 | p := filacts; { save top } |
| 1593 | filacts := filacts^.next; { gap } |
| 1594 | p^.next := filact; { push to destination } |
| 1595 | filact := p |
| 1596 | |
| 1597 | end |
| 1598 | |
| 1599 | end; |
| 1600 | |
| 1601 | {****************************************************************************** |
| 1602 | |
| 1603 | Execute build action |
| 1604 | |
| 1605 | Executes a command line for building. If the list actions flag is true, the |
| 1606 | action will be printed. If the dry flag is true, then no execution is done. |
| 1607 | |
| 1608 | ******************************************************************************} |
| 1609 | |
| 1610 | procedure excact(view cs: string); { command string } |
| 1611 | |
| 1612 | var r: integer; { command result code } |
| 1613 | |
| 1614 | begin |
| 1615 | |
| 1616 | { print command if requested } |
| 1617 | if fact then writeln(output, cs:*); |
| 1618 | if not fdry then begin { execute command } |
| 1619 | |
| 1620 | services.execw(cs, r); { execute } |
| 1621 | if r <> 0 then { error } |
| 1622 | error('Build has errors, terminating') |
| 1623 | |
| 1624 | end |
| 1625 | |
| 1626 | end; |
| 1627 | |
| 1628 | {****************************************************************************** |
| 1629 | |
| 1630 | Perform file action |
| 1631 | |
| 1632 | Performs the required action on each file entry. We check if the rebuild flag |
| 1633 | is on, which indicates the file is to be rebuilt. If that flag is not on, we |
| 1634 | do nothing. |
| 1635 | Then, we recompile the Pascal source. If there is an assembly file, this is |
| 1636 | simply done for error checking purposes. |
| 1637 | Then, if there is an assembly source, this is compiled, replacing the results |
| 1638 | of the Pascal compile. |
| 1639 | |
| 1640 | ******************************************************************************} |
| 1641 | |
| 1642 | procedure doact(fp: filept); |
| 1643 | |
| 1644 | var p, n, e: filnam; { path components } |
| 1645 | fns: filnam; { save for name } |
| 1646 | cmdbuf: linbuf; { command buffer } |
| 1647 | w: filnam; { single path holder } |
| 1648 | pt: filnam; { uses path holder } |
| 1649 | i: lininx; { index for that } |
| 1650 | x: 0..maxlin; { index for path } |
| 1651 | |
| 1652 | { place output character } |
| 1653 | |
| 1654 | procedure putchr(c: char); |
| 1655 | |
| 1656 | begin |
| 1657 | |
| 1658 | if i > maxlin then { overflow } |
| 1659 | error('Action command too long'); |
| 1660 | cmdbuf[i] := c; { place character } |
| 1661 | i := i+1 |
| 1662 | |
| 1663 | end; |
| 1664 | |
| 1665 | { place string in output } |
| 1666 | |
| 1667 | procedure putstr(view s: string); |
| 1668 | |
| 1669 | var i: integer; { index for name } |
| 1670 | |
| 1671 | begin |
| 1672 | |
| 1673 | { place name in link list } |
| 1674 | for i := 1 to len(s) do putchr(s[i]) |
| 1675 | |
| 1676 | end; |
| 1677 | |
| 1678 | procedure putflg(view s: string; e, f: boolean; prefix: boolean); |
| 1679 | |
| 1680 | begin |
| 1681 | |
| 1682 | if e then begin |
| 1683 | |
| 1684 | putstr(' -'); |
| 1685 | if prefix and not f then putchr('n'); |
| 1686 | putstr(s); |
| 1687 | if not prefix then |
| 1688 | if f then putchr('+') else putchr('-'); |
| 1689 | putchr(' ') |
| 1690 | |
| 1691 | end |
| 1692 | |
| 1693 | end; |
| 1694 | |
| 1695 | procedure plcpass(prefix: boolean); |
| 1696 | |
| 1697 | begin |
| 1698 | |
| 1699 | putflg('prtlabdef', sprtlabdef, fprtlabdef, prefix); |
| 1700 | putflg('lstcod', slstcod, flstcod, prefix); |
| 1701 | putflg('chk', schk, fchk, prefix); |
| 1702 | putflg('sourceset', ssourceset, fsourceset, prefix); |
| 1703 | putflg('varblk', svarblk, svarblk, prefix); |
| 1704 | putflg('experror', sexperror, fexperror, prefix); |
| 1705 | putflg('list', slist, flist, prefix); |
| 1706 | putflg('breakheap', sbreakheap, fbreakheap, prefix); |
| 1707 | putflg('recycle', srecycle, frecycle, prefix); |
| 1708 | putflg('chkoverflo', schkoverflo, fchkoverflo, prefix); |
| 1709 | putflg('chkreuse', schkreuse, fchkreuse, prefix); |
| 1710 | putflg('chkundef', schkundef, fchkundef, prefix); |
| 1711 | putflg('reference', sreference, freference, prefix); |
| 1712 | putflg('iso7185', siso7185, fiso7185, prefix); |
| 1713 | putflg('prttables', sprttables, fprttables, prefix); |
| 1714 | putflg('undestag', sundestag, fundestag, prefix); |
| 1715 | putflg('chkvar', schkvar, fchkvar, prefix); |
| 1716 | putflg('debug', sdebug, fdebug, prefix); |
| 1717 | putflg('debugflt', sdebugflt, fdebugflt, prefix); |
| 1718 | putflg('debugsrc', sdebugsrc, fdebugsrc, prefix); |
| 1719 | putflg('prtlex', sprtlex, fprtlex, prefix); |
| 1720 | putflg('prtdisplay', sprtdisplay, fprtdisplay, prefix); |
| 1721 | putflg('lineinfo', slineinfo, flineinfo, prefix); |
| 1722 | putflg('mrkasslin', smrklin, fmrklin, prefix); |
| 1723 | { error file: pcom only } |
| 1724 | if prefix and serrfil then begin |
| 1725 | putstr(' -errfile='); |
| 1726 | putstr(errfil); |
| 1727 | putchr(' ') |
| 1728 | end; |
| 1729 | |
| 1730 | end; |
| 1731 | |
| 1732 | begin |
| 1733 | |
| 1734 | if fp^.rebld and fp^.code then begin { this section is to be rebuilt } |
| 1735 | |
| 1736 | copy(fns, fp^.name); { make a copy of the name } |
| 1737 | services.brknam(fns, p, n, e); { remove the extention and place .pas } |
| 1738 | services.maknam(fns, p, n, 'pas'); |
| 1739 | services.fulnam(fns); { normalize it } |
| 1740 | { do information } |
| 1741 | if fverb then begin |
| 1742 | |
| 1743 | writeln('Building ', fns:*); |
| 1744 | if not fact then writeln |
| 1745 | |
| 1746 | end; |
| 1747 | |
| 1748 | { build pcom x x command } |
| 1749 | i := 1; { set 1st command filename } |
| 1750 | clears(cmdbuf); { clear command buffer } |
| 1751 | putstr('pcom'); |
| 1752 | putchr(' '); |
| 1753 | putstr(fns); |
| 1754 | putchr(' '); |
| 1755 | services.brknam(fns, p, n, e); { remove the extention and place .p6 } |
| 1756 | services.maknam(fns, p, n, 'p6'); |
| 1757 | services.fulnam(fns); { normalize it } |
| 1758 | putstr(fns); |
| 1759 | putchr(' '); |
| 1760 | { place target path } |
| 1761 | putstr(' --modules='); |
| 1762 | if len(tarpath) = 0 then putstr('.') else putstr(tarpath); |
| 1763 | putchr(' '); |
| 1764 | { place module path, if defined here } |
| 1765 | if len(modpth) > 0 then begin |
| 1766 | |
| 1767 | copy(pt, modpth); { copy module path } |
| 1768 | repeat { try path components } |
| 1769 | |
| 1770 | { extract a single path from the module path } |
| 1771 | x := indexp(pt, ':'); { find location of path divider } |
| 1772 | if x = 0 then begin { only one path left, use the whole thing } |
| 1773 | |
| 1774 | copy(w, pt); { place } |
| 1775 | clears(pt) { clear out the rest } |
| 1776 | |
| 1777 | end else begin { extract single path } |
| 1778 | |
| 1779 | extract(w, pt, 1, x-1); { get the path } |
| 1780 | extract(pt, pt, x+1, len(pt)) { remove from module path } |
| 1781 | |
| 1782 | end; |
| 1783 | { output this path } |
| 1784 | putstr(' --modules='); |
| 1785 | putstr(w); |
| 1786 | putchr(' ') |
| 1787 | |
| 1788 | until pt[1] = ' ' { until path is empty } |
| 1789 | |
| 1790 | end; |
| 1791 | plcpass(true); { place pass through options } |
| 1792 | excact(cmdbuf); { execute command buffer action } |
| 1793 | |
| 1794 | { build to assembly and generate object only if not interpreting } |
| 1795 | if not (fpint or fpmach or fcmach or fpack) then begin |
| 1796 | |
| 1797 | { build pgen x x command } |
| 1798 | i := 1; { set 1st command filename } |
| 1799 | clears(cmdbuf); { clear command buffer } |
| 1800 | putstr('pgen'); |
| 1801 | putchr(' '); |
| 1802 | services.brknam(fns, p, n, e); { remove the extention and place .p6 } |
| 1803 | services.maknam(fns, p, n, 'p6'); |
| 1804 | services.fulnam(fns); { normalize it } |
| 1805 | putstr(fns); |
| 1806 | putchr(' '); |
| 1807 | services.brknam(fns, p, n, e); { remove the extention and place .s } |
| 1808 | services.maknam(fns, p, n, 's'); |
| 1809 | services.fulnam(fns); { normalize it } |
| 1810 | putstr(fns); |
| 1811 | plcpass(false); { place pass through options } |
| 1812 | excact(cmdbuf); { execute command buffer action } |
| 1813 | |
| 1814 | i := 1; { set 1st command filename } |
| 1815 | clears(cmdbuf); { clear command buffer } |
| 1816 | putstr('gcc -static -g3'); |
| 1817 | putchr(' '); |
| 1818 | putstr('-c'); |
| 1819 | putchr(' '); |
| 1820 | services.brknam(fns, p, n, e); { remove the extention and place .p6 } |
| 1821 | services.maknam(fns, p, n, 's'); |
| 1822 | services.fulnam(fns); { normalize it } |
| 1823 | putstr(fns); |
| 1824 | putchr(' '); |
| 1825 | putstr('-o'); |
| 1826 | putchr(' '); |
| 1827 | services.brknam(fns, p, n, e); { remove the extention and place .s } |
| 1828 | services.maknam(fns, p, n, 'o'); |
| 1829 | services.fulnam(fns); { normalize it } |
| 1830 | putstr(fns); |
| 1831 | excact(cmdbuf); { execute command buffer action } |
| 1832 | |
| 1833 | end; |
| 1834 | |
| 1835 | { generate documentation if requested } |
| 1836 | if fdoc then begin |
| 1837 | |
| 1838 | i := 1; { set 1st command filename } |
| 1839 | clears(cmdbuf); { clear command buffer } |
| 1840 | putstr('pasdoc'); |
| 1841 | if fhtml then putstr(' -html'); |
| 1842 | putchr(' '); |
| 1843 | { reconstruct .pas filename } |
| 1844 | services.brknam(fns, p, n, e); |
| 1845 | services.maknam(fns, p, n, 'pas'); |
| 1846 | services.fulnam(fns); |
| 1847 | putstr(fns); |
| 1848 | putchr(' '); |
| 1849 | { place target path } |
| 1850 | putstr(' --modules='); |
| 1851 | if len(tarpath) = 0 then putstr('.') else putstr(tarpath); |
| 1852 | putchr(' '); |
| 1853 | { place module paths, if defined here } |
| 1854 | if len(modpth) > 0 then begin |
| 1855 | |
| 1856 | copy(pt, modpth); { copy module path } |
| 1857 | repeat { try path components } |
| 1858 | |
| 1859 | { extract a single path from the module path } |
| 1860 | x := indexp(pt, ':'); { find location of path divider } |
| 1861 | if x = 0 then begin { only one path left, use the whole thing } |
| 1862 | |
| 1863 | copy(w, pt); { place } |
| 1864 | clears(pt) { clear out the rest } |
| 1865 | |
| 1866 | end else begin { extract single path } |
| 1867 | |
| 1868 | extract(w, pt, 1, x-1); { get the path } |
| 1869 | extract(pt, pt, x+1, len(pt)) { remove from module path } |
| 1870 | |
| 1871 | end; |
| 1872 | { output this path } |
| 1873 | putstr(' --modules='); |
| 1874 | putstr(w); |
| 1875 | putchr(' ') |
| 1876 | |
| 1877 | until pt[1] = ' ' { until path is empty } |
| 1878 | |
| 1879 | end; |
| 1880 | excact(cmdbuf) { execute command buffer action } |
| 1881 | |
| 1882 | end; |
| 1883 | |
| 1884 | actcnt := actcnt+1 { count actions } |
| 1885 | |
| 1886 | end |
| 1887 | |
| 1888 | end; |
| 1889 | |
| 1890 | {****************************************************************************** |
| 1891 | |
| 1892 | Perform file actions on list |
| 1893 | |
| 1894 | Performs actions on each of the files in the action list. |
| 1895 | |
| 1896 | ******************************************************************************} |
| 1897 | |
| 1898 | procedure doacts; |
| 1899 | |
| 1900 | begin |
| 1901 | |
| 1902 | while filact <> nil do begin { until list is empty } |
| 1903 | |
| 1904 | doact(filact^.ref); { perform file action } |
| 1905 | filact := filact^.next { gap list top } |
| 1906 | |
| 1907 | end |
| 1908 | |
| 1909 | end; |
| 1910 | |
| 1911 | {****************************************************************************** |
| 1912 | |
| 1913 | Perform linkage and generate pass |
| 1914 | |
| 1915 | Links and generates the final executable. In gcc, both the compile phase and |
| 1916 | the link phase is done via gcc, but not really. It actually passes it on to |
| 1917 | ld. The difference is the compile phase converts .c or .s files into .o files, |
| 1918 | whereas ld links .o files |
| 1919 | |
| 1920 | For pint interpretation, linkage consists of concatenating all of the |
| 1921 | intermediate files into a combined file under the name of the target (which |
| 1922 | will overwrite the target intermediate). |
| 1923 | |
| 1924 | ******************************************************************************} |
| 1925 | |
| 1926 | procedure dolink; |
| 1927 | |
| 1928 | var p, n, e: filnam; { path components } |
| 1929 | fns: filnam; { save for name } |
| 1930 | fnc: filnam; { name of cmach.c } |
| 1931 | fpc: filnam; { path of cmach.c } |
| 1932 | fni: filnam; { name of intermediate } |
| 1933 | cmdbuf: linbuf; { command buffer } |
| 1934 | i: lininx; { index for that } |
| 1935 | main: filnam; { name for main module } |
| 1936 | psystem: filnam; { name for psystem module } |
| 1937 | |
| 1938 | { place output character } |
| 1939 | |
| 1940 | procedure putchr(c: char); |
| 1941 | |
| 1942 | begin |
| 1943 | |
| 1944 | if i > maxlin then { overflow } |
| 1945 | error('Action command too long'); |
| 1946 | cmdbuf[i] := c; { place character } |
| 1947 | i := i+1 |
| 1948 | |
| 1949 | end; |
| 1950 | |
| 1951 | { place string in output } |
| 1952 | |
| 1953 | procedure putstr(view s: string); |
| 1954 | |
| 1955 | var i: integer; { index for name } |
| 1956 | |
| 1957 | begin |
| 1958 | |
| 1959 | { place name in link list } |
| 1960 | for i := 1 to len(s) do putchr(s[i]) |
| 1961 | |
| 1962 | end; |
| 1963 | |
| 1964 | { concatenate list of files to output file } |
| 1965 | procedure catfils(view sfl, dfn: string); |
| 1966 | |
| 1967 | var df, sf: text; |
| 1968 | sn: filnam; |
| 1969 | i: integer; |
| 1970 | c: char; |
| 1971 | p, n, e: filnam; { path components } |
| 1972 | tn: filnam; |
| 1973 | |
| 1974 | begin |
| 1975 | |
| 1976 | services.brknam(dfn, p, n, e); |
| 1977 | services.maknam(tn, p, n, 'tmp'); |
| 1978 | assign(df, tn); |
| 1979 | rewrite(df); |
| 1980 | for i := 1 to words(sfl) do begin { for each file } |
| 1981 | |
| 1982 | extwords(sn, sfl, i, i); { get the current word } |
| 1983 | if not exists(sn) then error('File not found %', sn); |
| 1984 | assign(sf, sn); { open input file } |
| 1985 | reset(sf); |
| 1986 | { copy input to output file } |
| 1987 | while not eof(sf) do begin |
| 1988 | |
| 1989 | while not eoln(sf) do begin |
| 1990 | |
| 1991 | read(sf, c); |
| 1992 | write(df, c); |
| 1993 | |
| 1994 | end; |
| 1995 | readln(sf); |
| 1996 | writeln(df) |
| 1997 | |
| 1998 | end; |
| 1999 | close(sf); |
| 2000 | |
| 2001 | end; |
| 2002 | close(df); |
| 2003 | change(dfn, tn) |
| 2004 | |
| 2005 | end; |
| 2006 | |
| 2007 | begin { dolink } |
| 2008 | |
| 2009 | if fpint or fpmach or fcmach or fpack then begin { interpret } |
| 2010 | |
| 2011 | { remove extention from target } |
| 2012 | services.brknam(prgnam, p, n, e); |
| 2013 | services.maknam(fns, p, n, ''); |
| 2014 | if fverb then begin |
| 2015 | |
| 2016 | write('Building collected intermediate'); |
| 2017 | writeln |
| 2018 | |
| 2019 | end; |
| 2020 | if fact then begin |
| 2021 | |
| 2022 | { the shell can do a cat, but we can't. Print the command if asked, but |
| 2023 | we don't do it. } |
| 2024 | clears(cmdbuf); { clear command buffer } |
| 2025 | i := 1; { set 1st char } |
| 2026 | putstr('cat'); |
| 2027 | putchr(' '); |
| 2028 | putstr(lnklst); |
| 2029 | putchr(' '); |
| 2030 | putstr('>'); |
| 2031 | putchr(' '); |
| 2032 | putstr(fns); |
| 2033 | putstr('.p6'); |
| 2034 | writeln(cmdbuf:*) |
| 2035 | |
| 2036 | end; |
| 2037 | { for pint, just cat the files } |
| 2038 | if fpint then begin |
| 2039 | |
| 2040 | services.brknam(prgnam, p, n, e); |
| 2041 | services.maknam(fni, p, n, 'p6'); |
| 2042 | catfils(lnklst, fni) |
| 2043 | |
| 2044 | end; |
| 2045 | if fpmach or fcmach or fpack then begin |
| 2046 | |
| 2047 | { concatenate file } |
| 2048 | catfils(lnklst, fns); |
| 2049 | { prepare machine binary } |
| 2050 | clears(cmdbuf); { clear command buffer } |
| 2051 | i := 1; { set 1st char } |
| 2052 | putstr('pint --machdeck'); |
| 2053 | putchr(' '); |
| 2054 | putstr(fns); |
| 2055 | putstr('.p6'); |
| 2056 | putchr(' '); |
| 2057 | putstr(fns); |
| 2058 | putstr('.p6o'); |
| 2059 | putchr(' '); |
| 2060 | excact(cmdbuf) { execute command buffer action } |
| 2061 | |
| 2062 | end; |
| 2063 | if fpack then begin |
| 2064 | |
| 2065 | copy(fnc, 'cmach.c'); { set name of cmach } |
| 2066 | fndfilmod(fnc); { find on path } |
| 2067 | if not exists(fnc) then error('cmach.c not found'); |
| 2068 | services.brknam(fnc, fpc, n, e); { extract path of cmach } |
| 2069 | clears(cmdbuf); { clear command buffer } |
| 2070 | i := 1; { set 1st char } |
| 2071 | putstr('genobj'); |
| 2072 | putchr(' '); |
| 2073 | putstr(fns); |
| 2074 | putstr('.p6o program_code.c'); |
| 2075 | excact(cmdbuf); { execute command buffer action } |
| 2076 | clears(cmdbuf); { clear command buffer } |
| 2077 | i := 1; { set 1st char } |
| 2078 | putstr('gcc -DPACKAGE -DWRDSIZ64 -DGPC=0 -I. -I'); |
| 2079 | putstr(fpc); |
| 2080 | putchr(' '); |
| 2081 | putstr('-o'); |
| 2082 | putchr(' '); |
| 2083 | putstr(fns); |
| 2084 | putchr(' '); |
| 2085 | putstr(fnc); |
| 2086 | putchr(' '); |
| 2087 | putstr('-lm'); |
| 2088 | excact(cmdbuf) { execute command buffer action } |
| 2089 | |
| 2090 | end |
| 2091 | |
| 2092 | end else begin { build } |
| 2093 | |
| 2094 | { remove extention from target } |
| 2095 | services.brknam(prgnam, p, n, e); |
| 2096 | services.maknam(fns, p, n, ''); |
| 2097 | i := 1; { set 1st command filename } |
| 2098 | clears(cmdbuf); { clear command buffer } |
| 2099 | { find main } |
| 2100 | copy(main, 'main'); |
| 2101 | fndfil(main, true); |
| 2102 | if not exists(main) then { not found } |
| 2103 | error('Support module "%" not found', main); |
| 2104 | { find psystem } |
| 2105 | copy(psystem, 'psystem'); |
| 2106 | fndfil(psystem, true); |
| 2107 | if not exists(psystem) then { not found } |
| 2108 | writeln('*** pc: Error: support module "%"', psystem); |
| 2109 | if fverb then begin |
| 2110 | |
| 2111 | write('Building executable'); |
| 2112 | writeln |
| 2113 | |
| 2114 | end; |
| 2115 | { build gcc command } |
| 2116 | clears(cmdbuf); { clear command buffer } |
| 2117 | i := 1; { set 1st char } |
| 2118 | putstr('gcc -static -g3 -o'); |
| 2119 | putchr(' '); |
| 2120 | putstr(fns); |
| 2121 | putchr(' '); |
| 2122 | putstr(main); |
| 2123 | putchr(' '); |
| 2124 | putstr(lnklst); |
| 2125 | putchr(' '); |
| 2126 | putstr(psystem); |
| 2127 | putchr(' '); |
| 2128 | putstr('-lm -lpthread'); |
| 2129 | excact(cmdbuf) { execute command buffer action } |
| 2130 | |
| 2131 | end |
| 2132 | |
| 2133 | end; |
| 2134 | |
| 2135 | {****************************************************************************** |
| 2136 | |
| 2137 | Register file |
| 2138 | |
| 2139 | Performs various registration tasks on the file stack. We check if both .obj |
| 2140 | and .sym files are both present, and flag rebuild if not. Then, we check |
| 2141 | the time/date of both .obj and .sym files against the .pas and .asm file |
| 2142 | (if it exists), and see if the .pas or .asm file is newer than the output |
| 2143 | files. If so, it is marked rebuild. |
| 2144 | We don't compare the .obj and .sym files against each other. Although they |
| 2145 | should be nearly identical, I don't want to get into the situations (like |
| 2146 | pausing the linker) that could cause them to be radically different. |
| 2147 | |
| 2148 | ******************************************************************************} |
| 2149 | |
| 2150 | procedure regfil(fp: filept); { file head } |
| 2151 | |
| 2152 | begin |
| 2153 | |
| 2154 | { check both .obj and .sym files exist } |
| 2155 | if fp^.obje = nil then fp^.rebld := true { set rebuild } |
| 2156 | else begin { both outputs exist } |
| 2157 | |
| 2158 | { check times on source } |
| 2159 | if fp^.modify > fp^.obje^.modify then |
| 2160 | fp^.rebld := true; { old, set rebuild } |
| 2161 | if fp^.asme <> nil then { assembly exists } |
| 2162 | if fp^.asme^.modify > fp^.obje^.modify then |
| 2163 | fp^.rebld := true { old, set rebuild } |
| 2164 | |
| 2165 | end; |
| 2166 | { if global rebuild is set, set this rebuild flag } |
| 2167 | if frebld then fp^.rebld := true; |
| 2168 | { If the exclusion flag is on, then no rebuild is ever done. This can go |
| 2169 | ahead and cause an error if an essential file is missing. } |
| 2170 | if fp^.excl then fp^.rebld := false; |
| 2171 | { if the file contains no code, then also exclude from a rebuild } |
| 2172 | if not fp^.code and not compp(fp^.name, prgnam) then fp^.rebld := false |
| 2173 | |
| 2174 | end; |
| 2175 | |
| 2176 | {****************************************************************************** |
| 2177 | |
| 2178 | Check executive rebuild |
| 2179 | |
| 2180 | Checks if the executive needs to be rebuilt. This would occur if the .obj or |
| 2181 | .sym files for the target are newer than the .exe file, or the .exe file does |
| 2182 | not exist. Both of these files must have been rebuilt by this point in the |
| 2183 | code. |
| 2184 | |
| 2185 | Its possible that the .obj or .sym files could get deleted by another task, so |
| 2186 | we output a special error message for that. |
| 2187 | |
| 2188 | ******************************************************************************} |
| 2189 | |
| 2190 | procedure chkexc; |
| 2191 | |
| 2192 | var op, sp, ip, ep: filept; { file pointers } |
| 2193 | p, n, e: filnam; { path components } |
| 2194 | fn: filnam; { file name save } |
| 2195 | |
| 2196 | begin |
| 2197 | |
| 2198 | if fpint then begin { executive is an intermediate } |
| 2199 | |
| 2200 | services.brknam(prgnam, p, n, e); { break program name to components } |
| 2201 | { find the intermediate file } |
| 2202 | services.maknam(fn, p, n, 'p6'); |
| 2203 | dolist(fn, ip); |
| 2204 | if ip = nil then excrbl := true; { does not exist } |
| 2205 | if ip <> nil then dispose(ip) { release objects } |
| 2206 | |
| 2207 | end else if fpmach or fcmach or fpack then begin { executive is a p-machine binary } |
| 2208 | |
| 2209 | services.brknam(prgnam, p, n, e); { break program name to components } |
| 2210 | { find the pmachine binary file } |
| 2211 | services.maknam(fn, p, n, 'p6o'); |
| 2212 | dolist(fn, ip); |
| 2213 | if ip = nil then excrbl := true; { does not exist } |
| 2214 | if fpack then begin |
| 2215 | |
| 2216 | services.brknam(prgnam, p, n, e); { break program name to components } |
| 2217 | { find the executive file } |
| 2218 | services.maknam(fn, p, n, ''); |
| 2219 | dolist(fn, ep); |
| 2220 | if ep = nil then excrbl := true { does not exist } |
| 2221 | else if ip <> nil then if ep^.modify < ip^.modify then |
| 2222 | { exec date/time is older than .p6 execute rebuild } |
| 2223 | excrbl := true; |
| 2224 | if ep <> nil then dispose(ep); { release objects } |
| 2225 | |
| 2226 | end; |
| 2227 | if ip <> nil then dispose(ip); { release objects } |
| 2228 | |
| 2229 | end else begin { executive is a binary executable } |
| 2230 | |
| 2231 | services.brknam(prgnam, p, n, e); { break program name to components } |
| 2232 | { find each of .o, .s and executive files } |
| 2233 | services.maknam(fn, p, n, 'o'); |
| 2234 | dolist(fn, op); |
| 2235 | if op = nil then { should not be missing } |
| 2236 | error('Sequence error, missing file % check other tasks', fn); |
| 2237 | services.maknam(fn, p, n, 's'); |
| 2238 | dolist(fn, sp); |
| 2239 | if sp = nil then { should not be missing } |
| 2240 | error('Sequence error, missing file % check other tasks', fn); |
| 2241 | services.maknam(fn, p, n, ''); |
| 2242 | dolist(fn, ep); |
| 2243 | if ep = nil then excrbl := true { does not exist } |
| 2244 | else if (ep^.modify < op^.modify) or |
| 2245 | (ep^.modify < sp^.modify) then |
| 2246 | { exec date/time is older than .o or .s, execute rebuild } |
| 2247 | excrbl := true; |
| 2248 | if ep <> nil then dispose(ep); { release objects } |
| 2249 | dispose(op); |
| 2250 | dispose(sp) |
| 2251 | |
| 2252 | end |
| 2253 | |
| 2254 | end; |
| 2255 | |
| 2256 | {****************************************************************************** |
| 2257 | |
| 2258 | Register files |
| 2259 | |
| 2260 | Registers all of the files in the stack. |
| 2261 | |
| 2262 | ******************************************************************************} |
| 2263 | |
| 2264 | procedure regfils; |
| 2265 | |
| 2266 | var fp: filept; { pointer for files stack } |
| 2267 | |
| 2268 | begin |
| 2269 | |
| 2270 | fp := filstk; { index top of stack } |
| 2271 | while fp <> nil do begin { traverse } |
| 2272 | |
| 2273 | regfil(fp); { register single file } |
| 2274 | fp := fp^.stack { next } |
| 2275 | |
| 2276 | end |
| 2277 | |
| 2278 | end; |
| 2279 | |
| 2280 | {******************************************************************************* |
| 2281 | |
| 2282 | Parse and load instruction file |
| 2283 | |
| 2284 | Parses and loads a list of instructions from the instruction file. The format |
| 2285 | of the instruction file is: |
| 2286 | |
| 2287 | ! comment |
| 2288 | |
| 2289 | command param param...param |
| 2290 | |
| 2291 | Implemented instructions |
| 2292 | |
| 2293 | exclude <path>/<file> |
| 2294 | |
| 2295 | Causes the given path or file to be excluded from actions. Instead of adding a |
| 2296 | missing file there to a compile list, for example, an error will be produced |
| 2297 | instead. This command is used to protect library areas from recompilation. |
| 2298 | |
| 2299 | package <name> [<name>]... |
| 2300 | |
| 2301 | Indicates the given interface names are contained within the package file, |
| 2302 | which is a standard object that was multiply linked. |
| 2303 | |
| 2304 | usespath <path> |
| 2305 | |
| 2306 | Sets the uses path. This can also come from the environment, and if it appears |
| 2307 | here, will override the environment setting. This is the normal method used to |
| 2308 | create an "environment free" setup. |
| 2309 | |
| 2310 | *******************************************************************************} |
| 2311 | |
| 2312 | procedure parinst(view ifn: string); |
| 2313 | |
| 2314 | label nextline; { go to next line } |
| 2315 | |
| 2316 | const cmdmax = 250; |
| 2317 | |
| 2318 | var inshan: parse.parhan; { handle for instruction parsing } |
| 2319 | pn: filnam; { path of instruction file } |
| 2320 | fn: filnam; { filename holder } |
| 2321 | en: filnam; { extension holder } |
| 2322 | cp: filnam; { current path holder } |
| 2323 | cmd: filnam; { command verb } |
| 2324 | err: boolean; { parsing error } |
| 2325 | lp: lstptr; { pointer to file list entry } |
| 2326 | pp: pkgptr; { pointer to package list entry } |
| 2327 | |
| 2328 | procedure inserr(view es: string); |
| 2329 | |
| 2330 | begin |
| 2331 | |
| 2332 | parse.prterr(inshan, output, es, true); { print error } |
| 2333 | parse.getlin(inshan); { skip to new line } |
| 2334 | goto nextline |
| 2335 | |
| 2336 | end; |
| 2337 | |
| 2338 | { skip spaces allowing '\' to bridge lines } |
| 2339 | |
| 2340 | procedure lskpspc(inshan: parse.parhan); |
| 2341 | |
| 2342 | begin |
| 2343 | |
| 2344 | while not parse.endfil(inshan) and not parse.endlin(inshan) and |
| 2345 | ((parse.chkchr(inshan) = ' ') or (parse.chkchr(inshan) = '\\')) do begin |
| 2346 | |
| 2347 | parse.skpspc(inshan); { skip any spaces } |
| 2348 | if parse.chkchr(inshan) = '\\' then parse.getlin(inshan) { get next line } |
| 2349 | |
| 2350 | end |
| 2351 | |
| 2352 | end; |
| 2353 | |
| 2354 | { parse filename or string } |
| 2355 | |
| 2356 | procedure parfilstr(var fn: string); |
| 2357 | |
| 2358 | begin |
| 2359 | |
| 2360 | if parse.chkchr(inshan) = '"' then { check quoted } |
| 2361 | parse.parstr(inshan, fn, err) { get string parameter } |
| 2362 | else |
| 2363 | parse.parfil(inshan, fn, false, err); { get file parameter } |
| 2364 | if err then inserr('Invalid filename'); |
| 2365 | |
| 2366 | end; |
| 2367 | |
| 2368 | { clean ':' separated path for relative directories } |
| 2369 | |
| 2370 | procedure cleanpath(var pt: string); |
| 2371 | |
| 2372 | var w: filnam; |
| 2373 | ts: filnam; |
| 2374 | i: integer; |
| 2375 | |
| 2376 | begin |
| 2377 | |
| 2378 | clears(ts); { clear result } |
| 2379 | repeat |
| 2380 | |
| 2381 | { extract a single path from the module path } |
| 2382 | i := indexp(pt, ':'); { find location of path divider } |
| 2383 | if i = 0 then begin { only one path left, use the whole thing } |
| 2384 | |
| 2385 | copy(w, pt); { place } |
| 2386 | clears(pt) { clear out the rest } |
| 2387 | |
| 2388 | end else begin { extract single path } |
| 2389 | |
| 2390 | extract(w, pt, 1, i-1); { get the path } |
| 2391 | extract(pt, pt, i+1, len(pt)) { remove from module path } |
| 2392 | |
| 2393 | end; |
| 2394 | services.fulnam(w); |
| 2395 | { add new path } |
| 2396 | if ts[1] <> ' ' then cat(ts, ':'); |
| 2397 | cat(ts, w) |
| 2398 | |
| 2399 | until i = 0; { no more paths to extract } |
| 2400 | copy(pt, ts) { copy back result } |
| 2401 | |
| 2402 | end; |
| 2403 | |
| 2404 | begin |
| 2405 | |
| 2406 | if fverb then writeln('Reading instruction file', ifn:*); |
| 2407 | services.brknam(ifn, pn, fn, en); { extract path of instruction file } |
| 2408 | services.getcur(cp); { save current path } |
| 2409 | { this makes relative paths work } |
| 2410 | services.setcur(pn); { set path to instruction file path } |
| 2411 | parse.openpar(inshan); { open parser } |
| 2412 | parse.openfil(inshan, ifn, cmdmax); { open file to parse } |
| 2413 | |
| 2414 | nextline: { start new line } |
| 2415 | |
| 2416 | while not parse.endfil(inshan) do begin { process instructions } |
| 2417 | |
| 2418 | parse.skpspc(inshan); { skip leading spaces } |
| 2419 | if parse.chkchr(inshan) = '!' then { skip comment line } |
| 2420 | while not parse.endlin(inshan) do parse.getchr(inshan) |
| 2421 | else if not parse.endlin(inshan) then begin { command line } |
| 2422 | |
| 2423 | parse.parlab(inshan, cmd, err); { get command word } |
| 2424 | if err then inserr('Invalid command'); |
| 2425 | { find command } |
| 2426 | if compp(cmd, 'exclude') then |
| 2427 | while not parse.endlin(inshan) do begin |
| 2428 | |
| 2429 | lskpspc(inshan); { skip trailinging spaces } |
| 2430 | parfilstr(fn); { get filename } |
| 2431 | services.fulnam(fn); { expand it } |
| 2432 | new(lp); { get new exclude list entry } |
| 2433 | copy(lp^.name, fn); { place name as filename } |
| 2434 | lp^.next := exclude; { push onto list } |
| 2435 | exclude := lp; |
| 2436 | lskpspc(inshan) { skip trailing spaces } |
| 2437 | |
| 2438 | end else if compp(cmd, 'package') then begin |
| 2439 | |
| 2440 | lskpspc(inshan); { skip trailing spaces } |
| 2441 | parfilstr(fn); { get filename } |
| 2442 | services.fulnam(fn); { expand it } |
| 2443 | new(pp); { get new packaging entry } |
| 2444 | copy(pp^.name, fn); { place package root name } |
| 2445 | pp^.next := package; { push onto package list } |
| 2446 | package := pp; |
| 2447 | pp^.lst := nil; { clear contents list } |
| 2448 | parse.skpspc(inshan); { skip spaces } |
| 2449 | if parse.chkchr(inshan) <> '=' then inserr('''='' expected'); |
| 2450 | parse.getchr(inshan); { skip '=' } |
| 2451 | repeat { parse components } |
| 2452 | |
| 2453 | lskpspc(inshan); { skip trailing spaces } |
| 2454 | parfilstr(fn); { get filename } |
| 2455 | services.fulnam(fn); { expand it } |
| 2456 | new(lp); { get new list entry } |
| 2457 | copy(lp^.name, fn); { place package root name } |
| 2458 | lp^.next := pp^.lst; { push onto package list } |
| 2459 | pp^.lst := lp; |
| 2460 | lskpspc(inshan) { skip trailing spaces } |
| 2461 | |
| 2462 | until parse.endlin(inshan) { until line end } |
| 2463 | |
| 2464 | end else if compp(cmd, 'modulepath') then begin |
| 2465 | |
| 2466 | lskpspc(inshan); { skip trailing spaces } |
| 2467 | if parse.chkchr(inshan) = '"' then { check quoted } |
| 2468 | parse.parstr(inshan, fn, err) { get string parameter } |
| 2469 | else |
| 2470 | parse.parwrd(inshan, fn, err); { get module path } |
| 2471 | if err then inserr('Uses path too long or invalid'); |
| 2472 | cleanpath(fn); { clean the path up } |
| 2473 | if modpth[1] = ' ' then copy(modpth, fn) { just copy } |
| 2474 | else begin |
| 2475 | |
| 2476 | cat(modpth, ':'); { separate paths } |
| 2477 | cat(modpth, fn) { add new paths } |
| 2478 | |
| 2479 | end |
| 2480 | |
| 2481 | end else |
| 2482 | { standard mode } |
| 2483 | if compp(cmd, 'standard') then |
| 2484 | begin siso7185 := true; fiso7185 := true end |
| 2485 | else |
| 2486 | { no standard mode } |
| 2487 | if compp(cmd, 'nstandard') then |
| 2488 | begin siso7185 := true; fiso7185 := false end |
| 2489 | else |
| 2490 | { check input overflow } |
| 2491 | if compp(cmd, 'overflow') then |
| 2492 | begin schkoverflo := true; fchkoverflo := true end |
| 2493 | else |
| 2494 | { no check input overflow } |
| 2495 | if compp(cmd, 'noverflow') then |
| 2496 | begin schkoverflo := true; fchkoverflo := false end |
| 2497 | else |
| 2498 | { check references } |
| 2499 | if compp(cmd, 'refer') then |
| 2500 | begin sreference := true; freference := true end |
| 2501 | else |
| 2502 | { no check references } |
| 2503 | if compp(cmd, 'nrefer') then |
| 2504 | begin sreference := true; freference := false end |
| 2505 | else |
| 2506 | { keep terminal window } |
| 2507 | if compp(cmd, 'keepterminalwindow') then fngwin := true |
| 2508 | else |
| 2509 | { no keep terminal window } |
| 2510 | if compp(cmd, 'nkeepterminalwindow') then fngwin := false |
| 2511 | else |
| 2512 | { generate coff symbols in binary } |
| 2513 | if compp(cmd, 'symcoff') then fsymcof := true |
| 2514 | else |
| 2515 | { no generate coff symbols in binary } |
| 2516 | if compp(cmd, 'nosymcoff') then fsymcof := false |
| 2517 | else inserr('No such instruction'); |
| 2518 | parse.skpspc(inshan); { skip trailing spaces } |
| 2519 | if parse.chkchr(inshan) = '!' then { skip comment line } |
| 2520 | while not parse.endlin(inshan) do parse.getchr(inshan); |
| 2521 | if not parse.endlin(inshan) then inserr('Invalid command') |
| 2522 | |
| 2523 | end; |
| 2524 | parse.getlin(inshan) { skip to new line } |
| 2525 | |
| 2526 | end; |
| 2527 | parse.closefil(inshan); { close the file } |
| 2528 | parse.closepar(inshan); { close the parser instance } |
| 2529 | services.setcur(cp) { reset to current path } |
| 2530 | |
| 2531 | end; |
| 2532 | |
| 2533 | begin |
| 2534 | |
| 2535 | filstk := nil; { clear the files stack } |
| 2536 | services.filchr(valfch); { get the filename valid characters } |
| 2537 | clears(modpth); { clear module path } |
| 2538 | filcnt := 0; { clear files counter } |
| 2539 | filact := nil; { clear actions list } |
| 2540 | actcnt := 0; { set no actions performed } |
| 2541 | excrbl := false; { set executive does not need rebuild } |
| 2542 | exclude := nil; { clear exclude list } |
| 2543 | package := nil; { clear package list } |
| 2544 | |
| 2545 | { set flags } |
| 2546 | fverb := true; { verbose flag } |
| 2547 | ftree := false; { list dependency tree } |
| 2548 | fact := false; { list actions } |
| 2549 | fdry := false; { do not perform actions } |
| 2550 | frebld := false; { rebuild all } |
| 2551 | fdoc := false; { generate documentation } |
| 2552 | fhtml := false; { generate html documentation } |
| 2553 | fhelp := false; { print help } |
| 2554 | fdeftrm := false; { set no default to terminal mode } |
| 2555 | fdefgra := false; { set no default to graphical mode } |
| 2556 | fpint := false; { set no pint (interpreter) } |
| 2557 | fpmach := false; { set no pmach (interpreter) } |
| 2558 | fcmach := false; { set no cmach (interpreter) } |
| 2559 | fpack := false; { set no package (interpreter) } |
| 2560 | fpgen := true; { set executable mode by default } |
| 2561 | { passthrough } |
| 2562 | fprtlabdef := false; |
| 2563 | sprtlabdef := false; |
| 2564 | flstcod := false; |
| 2565 | slstcod := false; |
| 2566 | fchk := false; |
| 2567 | schk := false; |
| 2568 | fsourceset := false; |
| 2569 | ssourceset := false; |
| 2570 | fvarblk := false; |
| 2571 | svarblk := false; |
| 2572 | fexperror := false; |
| 2573 | sexperror := false; |
| 2574 | fecholine := false; |
| 2575 | secholine := false; |
| 2576 | flist := false; |
| 2577 | slist := false; |
| 2578 | fbreakheap := false; |
| 2579 | sbreakheap := false; |
| 2580 | frecycle := false; |
| 2581 | srecycle := false; |
| 2582 | fchkoverflo := false; |
| 2583 | schkoverflo := false; |
| 2584 | fchkreuse := false; |
| 2585 | schkreuse := false; |
| 2586 | fchkundef := false; |
| 2587 | schkundef := false; |
| 2588 | freference := false; |
| 2589 | sreference := false; |
| 2590 | fiso7185 := false; |
| 2591 | siso7185 := false; |
| 2592 | fprttables := false; |
| 2593 | sprttables := false; |
| 2594 | fundestag := false; |
| 2595 | sundestag := false; |
| 2596 | fchkvar := false; |
| 2597 | schkvar := false; |
| 2598 | fdebug := false; |
| 2599 | sdebug := false; |
| 2600 | fdebugflt := false; |
| 2601 | sdebugflt := false; |
| 2602 | fdebugsrc := false; |
| 2603 | sdebugsrc := false; |
| 2604 | fprtlex := false; |
| 2605 | sprtlex := false; |
| 2606 | fprtdisplay := false; |
| 2607 | sprtdisplay := false; |
| 2608 | flineinfo := false; |
| 2609 | slineinfo := false; |
| 2610 | fmrklin := false; |
| 2611 | smrklin := false; |
| 2612 | serrfil := false; |
| 2613 | |
| 2614 | fngwin := false; { do not override graphical windows switch } |
| 2615 | fsymcof := false; { do not generate coff symbols } |
| 2616 | siolib := false; { set no serial library found } |
| 2617 | grawin := false; { set no graphical windowing library found } |
| 2618 | errexit := false; { set no error exit } |
| 2619 | |
| 2620 | { process command line } |
| 2621 | parse.openpar(cmdhan); { open parser } |
| 2622 | parse.opencommand(cmdhan, cmdmax); { open command line level } |
| 2623 | services.filchr(valfch); { get the filename valid characters } |
| 2624 | valfch := valfch-['=','-']; { remove parsing characters } |
| 2625 | parse.setfch(cmdhan, valfch); { set that for active parsing } |
| 2626 | paropt; { parse command options } |
| 2627 | if fhelp then begin |
| 2628 | |
| 2629 | writeln('PC compiler shell vs. 1.14 Copyright (C) 2025 S. A. Franco'); |
| 2630 | writeln; |
| 2631 | writeln('Usage: pc [options] <filename> [options]'); |
| 2632 | writeln; |
| 2633 | writeln('Options:'); |
| 2634 | writeln(' -h -help Print this help message'); |
| 2635 | writeln(' -v -verbose Verbose mode'); |
| 2636 | writeln(' -t -tree List dependency tree'); |
| 2637 | writeln(' -a -action List actions'); |
| 2638 | writeln(' -d -dry Do not perform actions'); |
| 2639 | writeln(' -r -rebuild Rebuild all'); |
| 2640 | writeln(' -doc -document Generate documentation'); |
| 2641 | writeln(' -html Generate HTML documentation'); |
| 2642 | writeln(' -pint Compile for pint (interpreter)'); |
| 2643 | writeln(' -pmach Compile for pmach (interpreter)'); |
| 2644 | writeln(' -cmach Compile for cmach (compiler)'); |
| 2645 | writeln(' -package Compile for package mode'); |
| 2646 | writeln(' -pgen Compile for pgen mode (executable)'); |
| 2647 | writeln(' -ktw -keepterminalwindow Keep terminal window'); |
| 2648 | writeln(' -sc -symcoff Generate COFF symbols'); |
| 2649 | writeln(' -dt -defaultterminal Default to terminal mode'); |
| 2650 | writeln(' -dg -defaultgraphical Default to graphical mode'); |
| 2651 | writeln(' -mp -modulepath=<path> Set module search path'); |
| 2652 | writeln(' -ef -errfile=<file> Set error output file'); |
| 2653 | writeln; |
| 2654 | writeln('Passthrough options (passed to compiler):'); |
| 2655 | writeln(' -l -list Generate listing'); |
| 2656 | writeln(' -s -iso7185 ISO 7185 standard mode'); |
| 2657 | writeln(' -o -chkoverflo Check overflow'); |
| 2658 | writeln(' -a -debugflt Debug filter'); |
| 2659 | writeln(' -f -debugsrc Debug source'); |
| 2660 | writeln(' -chk Enable checking'); |
| 2661 | writeln(' -debug Enable debug mode'); |
| 2662 | writeln(' -reference Check references'); |
| 2663 | goto 99 |
| 2664 | |
| 2665 | end; |
| 2666 | if parse.endlin(cmdhan) then error('Filename expected'); |
| 2667 | parse.skpspc(cmdhan); { skip spaces } |
| 2668 | if parse.chkchr(cmdhan) = '"' then { parse string } |
| 2669 | parse.parstr(cmdhan, prgnam, err) { get string parameter } |
| 2670 | else |
| 2671 | parse.parfil(cmdhan, prgnam, false, err); { parse filename } |
| 2672 | if err then error('Invalid filename'); |
| 2673 | paropt; { parse command options } |
| 2674 | parse.skpspc(cmdhan); { skip to end } |
| 2675 | |
| 2676 | if fverb then begin |
| 2677 | |
| 2678 | writeln; |
| 2679 | writeln('PC compiler shell vs. 1.14 Copyright (C) 2025 S. A. Franco'); |
| 2680 | writeln |
| 2681 | |
| 2682 | end; |
| 2683 | |
| 2684 | if not parse.endlin(cmdhan) then error('Invalid command line'); |
| 2685 | services.getenv('MODULEPATH', modpth); { get any module path } |
| 2686 | if fverb and (modpth[1] <> ' ') then |
| 2687 | writeln('Environment module path: ', modpth:*); |
| 2688 | { find any instruction files for us } |
| 2689 | services.getpgm(pgmpath); { get the program path } |
| 2690 | services.getusr(usrpath); { get the user path } |
| 2691 | services.getcur(curpath); { get the current path } |
| 2692 | services.maknam(tmpnam, pgmpath, 'pc', 'ins'); { create instruction file name } |
| 2693 | if exists(tmpnam) then parinst(tmpnam); |
| 2694 | if not comp(usrpath, pgmpath) then begin |
| 2695 | |
| 2696 | { program and user paths are not identical } |
| 2697 | services.maknam(tmpnam, usrpath, 'pc', 'ins'); { create instruction file name } |
| 2698 | services.fulnam(tmpnam); { normalize } |
| 2699 | if exists(tmpnam) then parinst(tmpnam); |
| 2700 | if not comp(curpath, pgmpath) and not comp(curpath, usrpath) then begin |
| 2701 | |
| 2702 | { current path not equal to any of program or user paths } |
| 2703 | services.maknam(tmpnam, curpath, 'pc', 'ins'); { create instruction file name } |
| 2704 | services.fulnam(tmpnam); { normalize } |
| 2705 | if exists(tmpnam) then parinst(tmpnam) |
| 2706 | |
| 2707 | end |
| 2708 | |
| 2709 | end; |
| 2710 | if fverb and (modpth[1] <> ' ') then |
| 2711 | writeln('Final module path: ', modpth:*); |
| 2712 | services.brknam(prgnam, tarpath, n, e); { add Pascal extention } |
| 2713 | services.maknam(prgnam, tarpath, n, 'pas'); |
| 2714 | services.fulnam(prgnam); { expand relative } |
| 2715 | { see if there is an instruction file to go with it } |
| 2716 | services.maknam(tmpnam, tarpath, n, 'ins'); |
| 2717 | services.fulnam(tmpnam); { normalize } |
| 2718 | if exists(tmpnam) then parinst(tmpnam); |
| 2719 | { now check the file itself exists } |
| 2720 | if not exists(prgnam) then { file not found } |
| 2721 | error('Target file "%" not found', prgnam); |
| 2722 | logfil(prgnam, hp); { form tree from file } |
| 2723 | stdlib; { place standard libary } |
| 2724 | fndpkg; { find any included packages } |
| 2725 | regfils; { register files } |
| 2726 | if ftree then prtree; { print out the dependency tree } |
| 2727 | fndlnk; { find linking order } |
| 2728 | doacts; { perform per file actions } |
| 2729 | chkexc; { check executable needs rebuild } |
| 2730 | if (actcnt = 0) and not excrbl then |
| 2731 | writeln('No action required, files up to date') |
| 2732 | else |
| 2733 | if hp^.pgm then dolink; { perform link } |
| 2734 | if fverb and (actcnt > 0) then begin |
| 2735 | |
| 2736 | writeln; |
| 2737 | writeln('Build complete'); |
| 2738 | |
| 2739 | end; |
| 2740 | |
| 2741 | 99: { terminate program } |
| 2742 | |
| 2743 | seterr(ord(errexit)) |
| 2744 | |
| 2745 | end. |
Theory of Operation: pc.pas - Pascal Compiler Shell
====================================================
1. Overview
-----------
pc is a build orchestration tool for Pascal-P6 (Pascaline) projects. It acts
as a "make" equivalent: given a top-level Pascal source file, it discovers all
dependency modules via uses/joins declarations, determines which files are
out-of-date, and invokes the compiler toolchain (pcom, pgen, gcc) to rebuild
only what is necessary. It then links the results into a final executable (or
intermediate file for interpreter targets).
The program is itself written in Pascaline and uses the parse, services,
scanner, and strings libraries.
2. Program Flow
---------------
The main program body (line 2533) executes the following steps in order:
1. Initialize all flags and data structures.
2. Parse the command line (options + target filename).
3. Load instruction files (pc.ins) from program, user, current, and target
paths.
4. Log the target file, recursively discovering all dependencies.
5. Insert the standard I/O library if not already present.
6. Resolve package references.
7. Register files (determine which need rebuilding).
8. Optionally print the dependency tree (-tree).
9. Determine link order.
10. Execute build actions (compile out-of-date files).
11. Check if the final executable needs relinking.
12. Link if the target is a program.
Each step is described in detail below.
3. Command-Line Parsing
------------------------
The command line has the form:
pc [options] <filename> [options]
Options may appear before or after the filename. They are parsed by paropt
(line 282), which loops while the current character is the option character
('-'). Double-dash is also accepted.
Options fall into three categories:
(a) PC-internal flags: -verbose, -tree, -action, -dry, -rebuild, -doc,
-html, -help, -pint, -pmach, -cmach, -package, -pgen,
-keepterminalwindow, -symcoff, -defaultterminal, -defaultgraphical.
(b) Value options: -modulepath=<path>, -errfile=<file>.
(c) Passthrough flags: Options forwarded to pcom/pgen. Each has a pair of
variables (fXXX, sXXX) where fXXX holds the flag value (true/false) and
sXXX indicates whether the option was explicitly set. This allows pc to
only pass options that were actually specified by the user. Options can
be negated with an 'n' prefix (e.g., -niso7185) or with a +/- suffix.
4. Instruction Files
---------------------
pc searches for instruction files (pc.ins) in up to four locations, processed
in order:
1. The directory containing the pc executable (program path).
2. The user home directory (user path), if different from program path.
3. The current working directory, if different from both above.
4. Alongside the target file (<target>.ins).
Each instruction file is parsed by parinst (line 2312). The format uses '!'
for comments and supports the following directives:
exclude <path|file> - Prevent recompilation of the named path or file.
Used to protect library directories.
package <name> = <component> [<component>]...
- Declare that the listed component modules are
packaged within the named archive file.
modulepath <path> - Add to the colon-separated module search path.
Appends to any existing path.
standard / nstandard - Set/clear ISO 7185 standard mode.
overflow / noverflow - Set/clear overflow checking.
refer / nrefer - Set/clear reference checking.
keepterminalwindow / nkeepterminalwindow
- Set/clear terminal window persistence.
symcoff / nosymcoff - Set/clear COFF symbol generation.
The parser supports '\' line continuation within directive arguments.
Relative paths in instruction files are resolved relative to the instruction
file's own directory (the current directory is temporarily changed).
5. Dependency Discovery
------------------------
5.1 logfil (line 860)
This is the core recursive routine. Given a filename:
(a) Check if already logged (via schfil). If so, return the existing entry.
(b) Search for the .pas source file; error if not found.
(c) Search for companion files: .p6 (intermediate), .asm (assembly),
.o (object), .a (archive), and bare name (executable).
(d) Create a filety record with all found companion file entries.
(e) Push the record onto the global file stack (filstk).
(f) Call douses to scan the source for uses/joins and recursively log
each dependency.
5.2 douses (line 757)
Opens the Pascal source file via the scanner library and scans for uses/joins
declarations. For each module name found:
(a) Call fndfil to locate the file on the module path.
(b) Call logfil to recursively process it.
(c) Chain the dependency as a fillet link record on the caller's entry.
While scanning, douses also tracks whether the file contains code (variables,
fixed declarations, procedure/function bodies with active statements). Files
that contain no code are skipped during linking.
5.3 File Search (fndfil, fndfilmod, schfil)
fndfil (line 662) searches for a file by trying the target path first, then
each component of the colon-separated module path. For each path, it tries
extensions in order: .pas (unless searching for object only), .a, .o.
schfil (line 467) searches the file stack by comparing stripped names
(no path, no extension), so duplicate filenames from different paths are
detected.
fndfilmod (line 606) is a simpler variant that only searches the module path.
6. File Registration
---------------------
regfil (line 2150) determines if each file needs rebuilding:
- If no .o file exists, mark rebuild.
- If .pas is newer than .o, mark rebuild.
- If .asm exists and is newer than .o, mark rebuild.
- If global -rebuild flag is set, mark rebuild.
- If file is in the exclude list, clear rebuild (never rebuild excluded
files).
- If file contains no code and is not the main program, clear rebuild.
7. Link Order Resolution
--------------------------
fndlnk (line 1345) determines the order in which object files appear in the
link command. The algorithm is:
1. Place standard I/O libraries first (schstdio).
2. Place leaf modules (those with no dependencies) next (schleaf).
3. Repeatedly sweep for modules whose dependencies are all already listed
(schres). This is a topological sort by relaxation.
4. If no progress is made (cyclic dependency), warn and force-list an
unlisted entry (schnls), then continue.
5. The action list is reversed to get root-last order.
Object files are separated into two lists: .o files (Pascaline startup
compliant) and .a files (C/assembly archives). The .o files appear first in
the final link list, followed by .a files.
8. Build Execution
-------------------
8.1 doact (line 1642)
For each file marked for rebuild that contains code:
(a) Compile: invoke "pcom <file>.pas <file>.p6 --modules=<paths> [options]"
(b) Generate assembly: invoke "pgen <file>.p6 <file>.s [options]"
(skipped for interpreter targets)
(c) Assemble: invoke "gcc -static -g3 -c <file>.s -o <file>.o"
(skipped for interpreter targets)
(d) Documentation: if -doc is set, invoke "pasdoc [-html] <file>.pas
--modules=<paths>"
Each command is built in a cmdbuf (linbuf) using putchr/putstr helpers.
Passthrough options are formatted by plcpass, which handles the prefix/suffix
style differences between pcom (prefix: -nXXX) and pgen (suffix: -XXX+/-).
8.2 excact (line 1610)
Executes a command string via services.execw. If -action is set, the command
is printed. If -dry is set, execution is skipped. A non-zero return code
causes an error exit.
8.3 dolink (line 1926)
Performs the final link step. The behavior depends on the target mode:
- pgen (default): invoke "gcc -static -g3 -o <target> main.o <objects>
psystem.a -lm -lpthread". The main.o and psystem.a support modules are
located on the module path.
- pint: concatenate all .p6 intermediate files into a single .p6 file using
catfils.
- pmach/cmach: concatenate .p6 files, then invoke "pint --machdeck" to
produce a .p6o machine deck.
- package: additionally invoke "genobj" to produce a C object, then
"gcc -DPACKAGE ..." to compile and link the packaged binary.
9. Standard Library Handling
-----------------------------
stdlib (line 1091) checks if the dependency tree already contains a standard
I/O library (one of: terminal, graphical). If not, it selects a default
based on flags (-defaultterminal, -defaultgraphical) or falls back to
psystem. The chosen library is logged into the dependency tree.
The program also detects graphical windowing libraries (gralib, gmnlib) to
determine whether terminal window persistence is needed.
10. Package Handling
---------------------
Packages allow multiple modules to be linked into a single archive. The
package list (loaded from instruction files) maps a package name to its
component module names.
fndpkg (line 1173) operates in two sub-phases:
addpkg: For each component in a package definition, if that component
exists in the file stack, and the component is not already part of another
package, log the package file itself into the file stack. This uses
relaxation (repeated passes) since adding a package file may introduce
new dependencies.
lnkpkg: For each file in the stack, check if it matches a component of
any package whose package file is also in the stack. If so, link the
file to its containing package (fp^.pkg := cp). Files that are part of
a package are excluded from the individual link list (their code is
already in the package archive).
11. Exclusion
--------------
Files or directories listed via "exclude" directives are marked with
excl := true. Excluded files are never rebuilt. The check (chkexcl, line
504) matches either the full filename (without extension) or the directory
path against the exclude list.
This mechanism protects pre-built libraries from accidental recompilation.
12. Data Structures
--------------------
filety (line 88): The central record for each source file. Contains:
- name: full filename
- modify: modification timestamp (integer, epoch-based)
- rebld: whether the file needs rebuilding
- excl: whether the file is excluded from builds
- code: whether the file contains executable code
- stack: link to next file in the global file stack
- link: linked list of fillet records for dependencies
- list: whether already placed in the link order
- pgm: whether this is a program (vs. module)
- inte, asme, obje, arce, exec: companion file entries (.p6, .asm, .o,
.a, executable)
- pkg: link to containing package file (nil if not in a package)
fillet (line 109): Dependency link record. Each entry points to the
depended-upon filety and links to the next dependency.
lstety (line 117): Simple name list entry used for exclude lists and
package component lists. Uses pstring for the name.
pkgety (line 125): Package definition entry. Contains the package name,
a list of component names (lstety chain), and a link to the next package.
filstk: The global file stack. All discovered files are pushed here.
Traversal is via the stack field of filety.
filact: The build action list. An ordered list of files to process,
determined by the link order algorithm.
13. Error Handling
-------------------
The error procedure (line 224) supports printf-style formatting with '%'
markers for up to 5 string parameters. It writes to stdout, sets the
errexit flag, and jumps to the exit label (99). The program terminates
with seterr(ord(errexit)) which sets the process exit code.
14. Debug Section
------------------
14.1 Diagnostic Flags
The following flags are useful for diagnosing build problems:
-tree (-t): Prints the complete dependency tree. For each file, shows:
- Full filename with modification date/time
- Rebuild status and exclude status
- Whether it is a program or module
- Whether it contains code
- Companion files (intermediate, assembly, object, archive, executable)
- References (dependencies)
- Package membership
-action (-a): Prints every command that pc executes (pcom, pgen, gcc,
pasdoc invocations). Useful for seeing exactly what is being run.
-dry (-d): Prevents any commands from actually executing. Combined with
-action, this shows what WOULD happen without doing anything.
-verbose (-v): Enables informational messages during the build process,
including module path reporting, per-file build announcements, and
cycle warnings.
A typical diagnostic session:
pc -tree -action -dry myprogram.pas
This shows the full dependency tree, all commands that would be executed,
without actually running anything.
14.2 Instruction File Debugging
If instruction files are not loading correctly:
- Verbose mode prints "Reading instruction file<path>" for each
instruction file found and processed.
- It also prints the environment module path and the final module path
after all instruction files are processed.
- Instruction files are searched in order: program path, user path,
current path, target path. Each pc.ins is only loaded if it exists.
14.3 Common Problems and Diagnosis
Missing source file: "missing source file X" - The module named in a
uses/joins clause cannot be found on any module path. Check -verbose
output for the module path. Ensure the module path includes the directory
containing the missing file.
Bad uses/joins syntax: The scanner found something unexpected in a
uses/joins clause. Check the source file for syntax errors in the
module import declarations.
Build has errors, terminating: A subprocess (pcom, pgen, gcc) returned
a non-zero exit code. The error output from the subprocess should appear
above this message.
Link list too long: The combined list of object files exceeds filmax
(1000 characters). This is a hard limit in the link list buffer.
Action command too long: A single command line exceeds maxlin (1000
characters). This can happen with very long module paths.
Cycle was found in 'uses' declarations: Two or more modules reference
each other. This is not necessarily an error (Pascaline supports mutual
uses/joins), but pc warns about it in verbose mode. The link order
algorithm handles cycles by force-listing one entry to break the cycle.
No action required, files up to date: All object files are newer than
their sources. Nothing to build.
Sequence error, missing file: The .o or .s file for the main target
was expected to exist (it should have been built in an earlier step)
but is missing. This typically indicates interference from another
process.
Support module not found: main.o or psystem.a cannot be found on the
module path. These are required for native executable linking.
14.4 Rebuild Logic
A file is marked for rebuild when any of these conditions hold:
- No .o file exists for the source.
- The .pas source is newer than the .o file.
- An .asm file exists and is newer than the .o file.
- The -rebuild flag is set globally.
A file is exempt from rebuild when:
- It is in the exclude list (excl flag).
- It contains no code (no variables, fixed, procedures, or functions)
and is not the main program file.
The executable is relinked when:
- Any file was rebuilt (actcnt > 0).
- The executable is missing.
- The executable is older than any of its .o or .s inputs.
14.5 Internal Dump: dmppkg
The dmppkg procedure (line 1055) dumps the package list. It is not called
from the normal flow but can be inserted for debugging package resolution
issues. It prints each package name and its component list.
14.6 Build Pipeline
For the default pgen (native executable) target, each source file that
needs rebuilding goes through this pipeline:
.pas --[pcom]--> .p6 --[pgen]--> .s --[gcc -c]--> .o
Then all .o and .a files are linked:
main.o + <objects>.o + <archives>.a + psystem.a --[gcc]--> executable
For interpreter targets (pint/pmach/cmach), the pipeline is shorter:
.pas --[pcom]--> .p6
Then all .p6 files are concatenated into the final output.
14.7 Passthrough Option Handling
Each passthrough option uses a pair of boolean variables:
fXXX: The option's value (true or false).
sXXX: Whether the option was explicitly set by the user.
When building a command line, putflg checks sXXX first. If the option was
not set, it is omitted entirely (the subprocess uses its own default).
If set, the option is formatted according to the target's convention:
- pcom uses prefix style: -option or -noption
- pgen uses suffix style: -option+ or -option-
PC - PASCAL COMPILER SHELL
Copyright (C) 2001 S. A. Moore
Written 4/01
PC is a Pascal compilation shell. It examines the file given it, and forms a dependency tree by looking at all the files that appear in "uses" or "joins" statements. Then, the dates and times are checked against the object files, and components rebuilt as required. The command line is:
pc program [-option]...
Options:
-t or -tree - List the dependency tree.-a or -action - List the actions taken (commands performed)
-d or -dry - Do not actually perform anything. Used with -action to get a
list of what is going to happen before actually running the
operation.
-r or -rebuild - Treat all files as needing to be rebuilt.
-el or -errorlimit=n - Passthrough option to limit errors.
-nrf or -noreference - Passthrough option to remove reference checking.
-u or -uses=path - Direct specification of uses path.
Currently contains some Windows dependencies, which need to be removed:
1. Relys on directly outputting windows commands.
2. Relys on windows mode paths.
Remaining "to do" items:
1. Implement packages.
2. Have pc check what type the target file is, and if a module, perform
a compile without a link.