IMD 1.16: 6/09/2007 15:22:26 sys 1 system   ߋtv ?B-NO BOOT ON VOLUME @w p@w wP׭ ׭ w f& fwW#w v   @ @wP  @& 7 "  BLOCK@   IS BAD   -̂@ &   # p@ zw 7 P7 R & B g wD ѕ  Rì     s   p x] \Z 1  d s  -2&w*  SYS1Z ( LINK3B.TEXTni(, LINK.TEXTn,@ LINK2.TEXTnٜ@b LINK3A.TEXTnb~ LINK0.TEXTn~ LINK1.TEXTn霐 SYSSEGS.TEXTnٝ SYSTEM.B.TEXTn SYSTEM.TEXTn SYSTEM.C.TEXTlJ GLOBALS.TEXTn8 LIBRARY.TEXTn8R PATCH1.TEXTnfRf PATCH2.TEXTnffj FILER.TEXTlZj FILER.A.TEXTlZ FILER.B.TEXTlZ FILER.C.TEXTlZ FILER.D.TEX SYS1Z ( LINK3B.TEXTni(, LINK.TEXTn,@ LINK2.TEXTnٜ@b LINK3A.TEXTnTlZb~ LINK0.TEXTn~ LINK1.TEXTn霐 SYSSEGS.TEXTnٝ SYSTEM.B.TEXTn SYSTEM.TEXTn  *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribute this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from the Institute for Information Systems. *) $(* *) $(**** SYSTEM.C.TEXTlJ GLOBALS.TEXTn8 LIBRARY.TEXTn8R PATCH1.TEXTnfRf PATCH2.TEXTnffj FILER.TEXTlZj FILER.A.TEXTlZ FILER.B.TEXTlZ FILER.C.TEXTlZ FILER.D.TEXO^TlZ  (******************************************************************) $(*  ranges for the source seg to be placed in (* room allocated for segbase. This may involve disk read (* or perhaps only crea,orgleng := codeleng; ,addr := codeaddr *end; &addleng := 0; &addprocs := 0; &wp := procs; &while wp <> NIL do (begin { ting an empty segment. In any case (* segbase points at lowest addr, and nextspot is pointed (* at the next place code can add up final seg size } *addleng := addleng+wp^.defsym^.entry.place^.length; *if wp^.newproc = 0 then ,addprocs := addprocs+1be copied into. This is used (* for destbase assignment in readsrcseg. (} ( (procedure readnsplit; *var nblocks, n, pdlen; *wp := wp^.next (end; &mark(lheap); &segbase := getcodep(ord(lheap)); &segleng := orgleng+addleng+2*addprocs; &if segleng, .pddelta, nprocs: integer; ( cp0, cp1: codep; (begin *nblocks := (segleng+511) div 512; *if memavail-400 < nblocks*g <= 0 then (begin *error('size oflow'); *exit(linker) (end; &readnsplit; &last := fetchbyte(segbase, segleng-1); &wp := 256 then ,begin .error('no mem room'); .exit(linker) ,end; *n := nblocks; *repeat * { alloc heap space } ,new(cp1); procs; &while wp <> NIL do (begin { assign places in code seg } *with wp^.defsym^.entry.place^ do ,begin .destbase := nexts,n := n-1 *until n <= 0; *if sephost then ,begin { set up identity seg } .storeword(0, segbase, segleng-2); .nextspot := 0pot; .nextspot := nextspot+length ,end; *if wp^.newproc = 0 then ,begin { assign new proc # } .last := last+1; .if last > **************************************************************) $ ${ $* Readsrcseg determines the final segment size after a ,end *else ,begin { read from disk } .nblocks := (orgleng+511) div 512; .if blockread(seginfo[s]^.srcfile^.code^, segbase^dding $* in the external procs/funcs, allocates enough area for the $* entire output code seg, reads in the original code (o, 8nblocks, addr) <> nblocks then 0begin 2error('seg read err'); 2exit(linker) 0end; .pddelta := segleng-orgleng; .nprocsr uses $* identity segment for sephost special case), and splits the $* segdict off from the code. For all procs to-be-link := fetchbyte(segbase, orgleng-1); .pdleng := nprocs*2+2; $ nextspot := orgleng-pdleng; .cp0 := getcodep(ord(segbaseed, a new $* destbase position is assigned in seg and the new proc num is )+orgleng-pdleng); .cp1 := getcodep(ord(segbase)+segleng-pdleng); $ if cp0 <> cp1 then 0begin { move proc dict } 2n$* set up in pdict. The segment number field of the pdict is $* also updated to the value of s. All is ready to copy in th := pdleng; 2while n > 2 do 4begin 6storeword(pddelta+fetchword(segbase, orgleng-n), :segbase, orgleng-n); 6n := n-2 2 ene $* sep procs/funcs. The values for segbase and segleng are set $* here too. $} $ $procedure readsrcseg; $ var orglend; 2moveright(cp0^, cp1^, pdleng); 2fillchar(cp0^, pddelta, 0) , end ,end (end { readnsplit } ; & $begin { readsrcseg g, addr, *addleng, addprocs, *nextspot: integer; *last: 0..MAXPROC; *wp: workp; *lheap: ^integer; * ({ (* Readnsplit ar} &if sephost then (orgleng := 2 &else (with seginfo[s]^, srcfile^.segtbl.diskinfo[srcseg] do *begin  ed to show procedures' position. $} $ $procedure copyinprocs; $ var cp0, cp1, pdp, *jtab, sepbase: codep; *wp: workp; *c ,wp := next *end; &release(lheap) $end { copyinprocs } ; $ ${ ursp: segp; *lheap: ^integer; * ({ (* Readsepseg reads the sep seg in sp onto the heap as (* done in Phase 2. We set up $* Fixuprefs is called to search through reflists and fix $* operand fields of P-code and native code to refer to the $* rsepbase and cursp for (* copyinprocs. (} ( (procedure readsepseg(sp: segp); *var n, nblocks: integer; (begin *release(lhesolved values. If fixallrefs is true, then all pointers $* in the ref lists are used, otherwise the reference pointers $* eap); *n := sp^.srcfile^.segtbl.diskinfo[sp^.srcseg].codeleng; *nblocks := (n+511) div 512; *if memavail-400 < nblocks*256 thare checked to see if they occur in the procs to-be-linked. $} $ $procedure fixuprefs(work: workp; fixallrefs: boolean); &vaen ,begin .error('out of mem'); .exit(linker) ,end; *n := nblocks; *repeat ,new(sepbase); ,n := n-1 *until n <= 0; *ser n, i, ref, val: integer; *wp, wp1: workp; *rp: refp; *skipit: boolean; $ r: packed record /case boolean of 1TRUE: pbase := getcodep(ord(lheap)); *if blockread(sp^.srcfile^.code^, sepbase^, nblocks, (integ: integer); 1FALSE: (lowbyte: 0..255; 9highbyte: 0..255) -end { r } ; $begin &while work <> NIL do (with work^, refs.sp^.srcfile^.segtbl.diskinfo[sp^.srcseg].codeaddr) <> nblocks then ,begin .error('sep seg read err'); .exit(linker) ,end; ym^.entry do *begin { for each work item } , { figure resolve val } ,case litype of .SEPPREF, .SEPFREF: val := defproc^*cursp := sp (end { readsepseg } ; ( $begin { copyinprocs } &sepbase := NIL; &cursp := NIL; &mark(lheap); &wp := procs; .newproc; .UNITREF: val := defsegnum; .CONSTREF: val := defsym^.entry.constval; .GLOBREF: val := defsym^.entry.icoffset+ ?&while wp <> NIL do (with wp^, defsym^.entry do *begin { copy in each proc } ,if cursp <> defseg then .readsepseg(defseg); defproc^.defsym^.entry.place^.destbase; .PUBLREF, .PRIVREF: begin :if litype = PRIVREF then  0 then .st locations set up in readsrcseg. If all goes right, we should $* fill dest seg to the exact byte. The proc dict is $* updatorebyte(newproc, jtab, 0); $ pdp := getcodep(ord(segbase)+segleng-2*newproc-2); ,storeword(ord(pdp)-ord(jtab), pdp, 0);  >begin @r.highbyte := val mod 256; @r.lowbyte := val div 256 + 128; @val := r.integ >end 8 else >error('addr oflow') eginfo[s]^, segtbl do (begin *nblocks := (segleng+511) div 512; *if blockwrite(code, segbase^, nblocks, nextblk) <> nblocks t8end ,end; $ n := nrefs; ,rp := reflist; ,while rp <> NIL do .begin 0if n > 8 then 2begin 4i := 7; 4n := n-8 2hen ,begin .error('code write err'); .exit(linker) ,end; *diskinfo[s].codeaddr := nextblk; end 0else 2i := n-1; 0repeat 2ref := rp^.refs[i]; 2skipit := not fixallrefs; 2if skipit then 4begin { see if pertinent } *diskinfo[s].codeleng := segleng; *segname[s] := srcfile^.segtbl.segname[srcseg]; *segkind[s] := LINKED; *nextblk := nextblk6wp := NIL; 6wp1 := procs; 6while wp1 <> NIL do 8if wp1^.defseg = refseg then :begin { find matching seg }  NIL) and skipit do 8if wp^.defseg = refseg then :with wp^.defsym^.enfile. The global var s has the seginfo index $* pertaining to the segment, and all the other procedures of $* Phase 3 are ctry.place^ do = srcbase then >if ref < srcbase+length then @begin Bref := ref-srcbase+destbase; Bskipit := FALSE alled from here. This proc facilitates linking $* the master seg separatly from the other segs to ensure that $* the DATASZ@end >else @wp := wp^.next wp := NIL 4 else :wp := NIL 4end; 2if not skipit then  of the outer block correctly reflects the number $* of PRIVREF words allocated by resolve. $} $ $procedure linksegment; &4case format of { fix up this ref } 6WORD: storeword(val+fetchword(segbase, ref), Psegbase, ref); 6BYTE: storebyte(val, s ({ (* Writemap is called for each seg to write some (* info into map file. (} ( (procedure writemap; *var wp: workp; egbase, ref); 6BIG: storeword(val, segbase, ref) 4end; 2i := i-1 0until i < 0; 0rp := rp^.next .end; ,work := next *en.b: boolean; (begin *with seginfo[s]^ do ,writeln(map, 'Seg # ',s,', ', srcfile^.segtbl.segname[srcseg]); *wp := procs; *ifd $end { fixuprefs } ; & ${ $* writetocode takes the finalized destseg and puts it in $* the output code file. This also wp <> NIL then * writeln(map, ' Sep procs'); *while wp <> NIL do ,with wp^.defsym^.entry do .begin  involves setting up values $* in the final segtable for writeout just before locking it. $} $ $procedure writetocode; $ 0write(map, ' ', name); 0if litype = SEPPROC then 2write(map, ' proc') 0else 2write(map, ' func'); 0write(map, ' # ',var nblocks: integer; $ jtab: codep; $begin $ if hostsp = seginfo[s] then (begin { fix up baselc } *jtab := getcodep( wp^.newproc: 3); 0write(map, ' base =', place^.destbase: 6); 0write(map, ' leng =', place^.length: 5); 0writeln(map); = 0 thenord(segbase)+segleng-4); *jtab := getcodep(ord(jtab)-fetchword(jtab, 0)); *storeword(nextbaselc*2-6, jtab, -8) (end; &with s  '' $end; "if useworkfile then $rewrite(code, '*SYSTEM.WRK.CODE[*]') "else $rewrite(code, fname); "if IORESULT <> 0 then $begin &error('Code open err'); &exit(linker) $end; "nextblk := 1; "{ clear output seg table } "fillchar(segtbl, sizeof(se0wp := wp^.next .end; *for b := FALSE to TRUE do ,begin .if b then 0begin 2wp := other; 2if wp <> NIL then 2 writeln(mgtbl), 0); "with segtbl do $for s := 0 to MAXSEG do &begin (segname[s] := ' '; (segkind[s] := LINKED &end; ap, ' Sep proc refs') 0end .else 0begin 2wp := local; 2if wp <> NIL then 2 writeln(map, ' Local seg refs') 0end; .w"if mapname <> '' then $begin &rewrite(map, mapname); " if IORESULT <> 0 then (begin *writeln('Can''t open ', mapname);hile wp <> NIL do 0with wp^.defsym^.entry do 2begin 4write(map, ' ', name); 4case litype of 6SEPPROC, 6SEPFUNC: ;  *mapname := '' (end &else & begin *write(map, 'Link map for '); *if hostsp <> NIL then ,writeln(map, hostsp^.srcfile^.s6PUBLDEF: write(map, ' public LC =', baseoffset: 5); 6CONSTDEF: write(map, ' const val =', constval: 6); 6PRIVREF: write(egtbl.segname[hostsp^.srcseg]) *else ,writeln(map, 'assem host'); *writeln(map) $ end $end; "mark(heapbase); "unitwritmap, ' privat LC =', wp^.newoffset: 5); 6UNITREF: write(map, ' unit seg# =', wp^.defsegnum: 3); 6GLOBDEF: write(map, ' gloe(3, heapbase^, 35); "{ link all but host } "for s := 0 to MAXSEG do $if (seginfo[s] <> NIL) $and (seginfo[s] <> hostsp) theb def in ', Dwp^.defproc^.defsym^.entry.name, D' @', icoffset: 5) 4end; 4writeln(map); 4wp := wp^.next 2end ,end; n &linksegment; "{ link host last! } "if hostsp <> NIL then $begin &s := MASTERSEG; &linksegment $end; "if blockwrite(co*writeln(map) (end { writemap } ; ( $begin { linksegment } &sephost := FALSE; &segbase := NIL; &segleng := 0; &if talkatde, segtbl, 1, 0) <> 1 then $error('Code write err'); "if errcount = 0 then $begin { final cleanup } &close(code, LOCK); &iive then (with seginfo[s]^ do *writeln('Linking ', * srcfile^.segtbl.segname[srcseg], ' # ', s); &buildworklists; &f useworkfile then (with userinfo do *begin ,gotcode := TRUE; ,codevid := syvid; ,codetid := 'SYSTEM.WRK.CODE' *end; &if if errcount = 0 then (begin *readsrcseg; *if mapname <> '' then ,writemap; *copyinprocs; *fixuprefs(local, TRUE); *fixuprmapname <> '' then (begin *if hostsp <> NIL then ,writeln(map, 'next base LC = ', nextbaselc); *close(map, LOCK) $ end efs(other, FALSE); *writetocode (end; &if sephost then (seplist := seginfo[s]^.next; &release(heapbase) $end { linksegment$end   end { phase3 } ;   } ; $  begin { phase3 } "if not useworkfile then $begin &write('Output file? '); &readln(fname); &useworkfile := fname = {$I link0 }  {$I link1 }  {$I link2 }  {$I link3a }  {$I link3b }   begin { linker } "phase1; "phase2; "phase3;  unitclear(3)  end { linker } ;   begin end.  O^O^ he Institute for Information Systems. *) $(* *) $(****(end { getentry } ; & ({ (* Addunit is called to find or allocate a library unit (* that is found in link info as an exte**************************************************************) $  {  * Phase2 reads in all linker info associated with  * rnal ref. This (* occurs in lib units which use other units. If (* the unit can't be found or no room, error is called. ( the segs in seginfo and sep seg list. Again all  * fields are checked carefully. As a help to phase3,  * ref lists are co} ( (procedure addunit(var name: alpha); *var fp: finfop; seg: integer; (begin *fp := unitsrch(hostfile, name, seg); *if fllected and place records for sep  * proc/func are computed. Some small optimization is  * done to eliminate the sep seg lip <> NIL then ,if fp <> hostfile then .if fp^.segtbl.diskinfo[seg].codeleng <> 0 then 0if nextseg = MAXSEG1 then 2error('no st if it is not  * going to be needed, saving a few disk IO's.  }   procedure phase2;  var s: segindex; &sp: segp; room in seginfo') 0else 2begin { allocate new seginfo el } 4new(seginfo[nextseg]); 4with seginfo[nextseg]^ do 6begin 8srcf&dumpseps: boolean; & ${ $* Readlinkinfo reads in the link info for segment sp $* and builds its symtab. Some simple disile := fp; 8srcseg := seg; 8segkind := UNITSEG; 8symtab := NIL 6end; 4nextseg := nextseg+1 2end (end { addunit } ; ) ({k io routines $* do unblocking, and all fields are again verified. $* The only legal litypes are in oktypes. Assume that $* (* Validate verifies lientry format. (* If the entry is SEPPROC or FUNC (* then a place rec is allocated for buildplace.  sp <> NIL $} $ $procedure readlinkinfo(sp: segp; oktypes: liset); &var rp, rq: refp; *syp: symp; *errs, nrecs, nextblk,  If (* a UNITREF is found, it searched for and possibly (* allocated. If the unit must be added to seginfo, recsleft: integer; *entry, temp: lientry; *buf: array [0..31] of 1array [0..7] of integer; * ({ (* Getentry reads an 8 word record from disk buf (* sequentially. No validity checking is done here, (* only disk read errors. (} ( (procedure ge  (******************************************************************) $(* tentry(var entry: lientry); ( var err: boolean; (begin *err := FALSE; *if recsleft = 0 then ,begin .recsleft := 32; .err *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribu := blockread(sp^.srcfile^.code^, buf, 1, nextblk) <> 1; .if err then 0error('li read err') , else 0nextblk := nextblk+1 te this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from t,end; *moveleft(buf[32-recsleft], entry, 16); *if err then ,entry.litype := EOFMARK; *recsleft := recsleft-1  0SEPFREF, 0UNITREF, 0GLOBREF, 0PUBLREF, 0PRIVREF, 0CONSTREF: begin =reflist := NIL; =if (nrefs < 0) =or (nrefs > 500) tf rec } 0getentry(temp); 0new(rp); 0moveleft(temp, rp^.refs, 16); 0rp^.next := entry.reflist; 0entry.reflist := rp; hen ?error('too many refs'); =if not (format in [WORD, BYTE, BIG]) then ?error('bad format'); =if litype = PRIVREF then ?if0nrecs := nrecs-1 .end; ,{ reverse ref list } ,rp := entry.reflist; ,entry.reflist := NIL; ,while rp <> NIL do .begin 0r (nwords <= 0) ?or (nwords > MAXLC) then Aerror('bad private'); =if litype = UNITREF then ?addunit(name) ;end; 0GLOBDEF: q := rp^.next; 0rp^.next := entry.reflist; 0entry.reflist := rp; 0rp := rq .end *end; (if entry.litype = EOFMARK then *if if (homeproc <= 0) ;or (homeproc > MAXPROC) ;or (icoffset < 0) ;or (icoffset > MAXIC) then =error('bad globdef'); 0PUBLDEF sp^.segkind = HOSTSEG then ,if (entry.nextlc > 0) ,and (entry.nextlc <= MAXLC) then .nextbaselc := entry.nextlc * else .e: if (baseoffset <= 0) ;or (baseoffset > MAXLC) then =error('bad publicdef'); 0EXTPROC, 0EXTFUNC, 0SEPPROC, 0SEPFUNC: rror('bad host LC') *else (else *if errs = errcount then ,begin { ok...add to symtab } .new(syp); .syp^.entry := entry; .begin =if litype in [SEPPROC,SEPFUNC] then ?new(place) { for use in buildplaces } =else ?place := NIL; =if (srcproc <= 0) entersym(syp, sp^.symtab) ,end &until entry.litype = EOFMARK $end { readlinkinfo } ; $ ${ $* Buildplaces reads code of se=or (srcproc > MAXPROC) =or (nparams < 0) =or (nparams > 100) then ?error('bad proc/func') ;end .end { case litype } (endp segs from disk to generate $* the placerec entries for use during phase3. The seg is $* read into the heap and the grossn { validate } ; $ $begin { readlinkinfo } &recsleft := 0; { 8 wd recs left in buf } &with sp^.srcfile^.segtbl, diskinfoess begins. Assume that $* sp <> NIL $} $ $procedure buildplaces(sp: segp); &var cp: codep; heap: ^integer; *nbytes, nblo[sp^.srcseg] do (begin { seek to linkinfo } *nextblk := codeaddr + (codeleng+511) div 512; *if talkative then ,writeln('Readcks, nprocs, n: integer; $ ({ (* procsrch recursivly searches symtab of sp to find ing ', segname[sp^.srcseg]) (end; &repeat (getentry(entry); (errs := errcount; (if entry.litype <> EOFMARK then *if entry.(* sepproc and sepfunc entries and build the actual (* place record for the link info entry by indexing (* thru proc dict litype in oktypes then ,validate(entry) *else ,begin , error('bad litype'); .entry.litype := EOFMARK ,end; (if dumpseps to jtab and using entric field. (} ( (procedure procsrch(symtab: symp); *var i, j: integer; (begin *if symtab <> NIL then (* it is placed after current position so it will have (* its link info read as well. (} ( (procedure validate(var entry:then *if entry.litype in [SEPPREF, SEPFREF, >EXTPROC, EXTFUNC, >GLOBREF] then ,dumpseps := FALSE; { we need them! } (if en lientry); (begin *with entry do ,if not alphabetic(name) then .error('non-alpha name') ,else .case litype of 0SEPPREF, try.litype in reflitypes then *begin { read ref list } ,nrecs := (entry.nrefs+7) div 8; ,while nrecs > 0 do .begin { read re  } " "dumpseps := TRUE; { assume we don't need sep segs } "for s := 0 to MAXSEG do $if seginfo[s] <> NIL then &case segi,begin .procsrch(symtab^.llink); .procsrch(symtab^.rlink); .procsrch(symtab^.slink); .with symtab^.entry do 0if litype in nfo[s]^.segkind of (LINKED: ; { nothin } (UNITSEG: readlinkinfo(seginfo[s], [PUBLREF, PRIVREF, UNITREF, [SEPPROC, SEPFUNC] then 2if (srcproc <= 0) or (srcproc > nprocs) then 4error('bad proc #') 2else { find byte place in code } MCONSTDEF,EXTPROC, EXTFUNC]); (SEPRTSEG: readlinkinfo(seginfo[s], [GLOBREF, GLOBDEF, MSEPPROC, SEPFUNC]); (HOSTSEG: readl4begin 6i := nbytes-2-2*srcproc; { point i at proc dict } 6i := i-fetchword(cp, i); { point i at jtab } 6if (fetchinkinfo(seginfo[s], [PUBLDEF, CONSTDEF, MEXTPROC, EXTFUNC]); (SEGPROC: readlinkinfo(seginfo[s], [EXTPROC, EXTFUNC]) &end { byte(cp, i) <> srcproc) 6and (fetchbyte(cp, i) <> 0) then 8error('disagreeing p #') 6else 8begin :j := fetchword(cp, i-2)+4cases } ;  "{ now do sep list elements } " "if dumpseps then $seplist := NIL; "sp := seplist; "while sp <> NIL do $be; :place^.srcbase := i+2-j; :if (place^.srcbase < 0) :or (j <= 0) or (j > MAXIC) then  &nbytes := sp^.srcfile^.segtbl.diskinfo[sp^.srcseg].codeleng; &nblocks := (nbytes+511) div 512; &if memavail-400 < nblocks*25NIL do $begin &buildplaces(sp); &sp := sp^.next $end; "if errcount > 0 then $exit(linker)  end { phase2 } ; 6 then (error('sep seg 2 big') &else (begin { alloc space in heap } *mark(heap); *n := nblocks; *repeat ,new(cp); ,n := n-1 *until n <= 0; *if blockread(sp^.srcfile^.code^, heap^, nblocks, /sp^.srcfile^.segtbl.diskinfo[sp^.srcseg].codeaddr) <> nblocks then ,error('sep seg read err') *else ,begin .cp := getcodep(ord(heap)); .nprocs := fetchbyte(cp, nbytes-1); .if (nO^procs < 0) or (nprocs > MAXPROC) then 0error('bad proc dict') .else 0procsrch(sp^.symtab) ,end; *release(heap) (end $end { buildplaces } ; $  begin { phase2 } " "mark(heapbase); "unitwrite(3, heapbase^, 35); " "{ read link info for host segs    * massaging. For each segment in seginfo to be placed  * into the output code file, all referenced procedures  * and fun &uprocs, { unresolved external proc/func work list } &procs, { resolved list of above items } &ulocal, ctions are found, globals and other refs are  * resolved, and finally the final code segment is built.  * In the case of a S { unresolved list of updates for seginfo entry } &local, { resolved list of fixups that came along with seEPRTSEG host (eg an interpreter), then  * all the procs in it are put in the unresolved list and g } &uother, { unresolved work list of things other than procs } &other: workp; { resolved list of above } &sep * the host seg is made to appear as just another sep seg.  * This drags along all the original procedures and maintains  *host: boolean; { flag for interpreter host case (only seg #1) } &fname: string[39];{ output code file name } &segtbl: I5segtbl their original ordering for possible ASECT integrity.  }   procedure phase3; "type &workp = ^workrec; { all seg work is driven by these lists } &workrec = record 2next: workp; { list link } 2refsym, { symtab entry of unresolved name } 2defsym: symp; { " " " resolving entry } 2refseg, { seg refls point into, refrange only } 2defseg: segp; { seg where defsym was found } 2case litypes of { same as litype in refsym^.entr  (******************************************************************) $(* y } 0 SEPPREF, 4SEPFREF, 4GLOBREF: 8(defproc: workp); { work item of homeproc } 4UNITREF: 8(defsegnum: segrange); *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribu { resolved seg #, def = ref } 4PRIVREF: 8(newoffset: lcrange); { newly assigned base offset } 4EXTPROC, 4EXTFUNC, 4SEPPte this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from tROC, 4SEPFUNC: 8(needsrch: boolean; { refs haven't been found } 9newproc: 0..MAXPROC) { proc #, comp or link chosen } he Institute for Information Systems. *) $(* *) $(****2end { workrec } ; { 0 implies added proc } " "var s: segindex; &segbase: codep; { address of current seg bein**************************************************************) $  {  * Phase3 of the linker does all the real work of code g crunched } &segleng, { final code seg length for writeout } &nextblk: integer; { next available output code block }  which has work items which have at least one $* ref occuring in the procs or funcs in the procs list. $} $ $procedure buildinto the uprocs list, the defining proc is located and (* added into uprocs. (} ( (procedure findnewprocs; *var wp, wp1: wworklists; &var sp: segp;  wp: workp; $ ({ (* Findprocs goes through symtab and builds a list of (* procedure orkp; ( pnum: integer; ( ,{ ,* Findnadd finds the procedure numbered pnum in the ,* symbol table symtab. An error iand functions which occur in the tree and (* whose litype is in the okset. The resulting list (* is not ordered in any parts given if the ,* required proc cannot be found. It returns a work ,* node for the proc once it has been found. This ,* icular fashion. It is (* called to build initial uproc list. (} $ node is also added into the uprocs list. Any procs ,* added this way are "invisible", dragged along because ,* of global re(function findprocs(okset: liset; symtab: symp): workp; *var work: workp; * ,{ ,* procsrch recursivly searches subtrees tofs/defs. ,} , ,function findnadd(symtab: symp): workp; ( 0{ 0* procsrch recursivly searches the sym tree looking 0* for pick out ,* those symbols which are in the okset, generates ,* new work nodes, and puts them into local work list. ,} ,  the actual symbol containing pnum. This does 0* most of the work of findnadd. 0} 0 0procedure procsrch(sym: symp); 2var ,procedure procsrch(sym: symp); .var wp: workp; ,begin .if sym <> NIL then 0begin 2procsrch(sym^.llink); 2procsrch(sym^.rwp: workp; 0begin 2if sym <> NIL then 4begin 6procsrch(sym^.llink); 6procsrch(sym^.rlink); 6procsrch(sym^.slink); ; { output code's seg table } &map: text; { map text output file } & ${ $* Buildworklists is called for all segmentslink); 2procsrch(sym^.slink); 2if sym^.entry.litype in okset then 4begin { place new node in list } 6new(wp); 6wp^.refsym : which need to $* be copied, and maybe need to have sepprocs or others stuff = sym; 6wp^.refseg := NIL; 6wp^.defsym := NIL; 6wp^.defseg := NIL; 6wp^.needsrch := TRUE; 6if sephost then 6 wp^.newproc $* fixed up within them. The idea here is to get a list $* of procs and other item needing attention, with $* all the sub:= 0 { see readsrcseg! } 6else 8wp^.newproc := sym^.entry.srcproc; 6wp^.next := work; 6work := wp 4end 0end ,end { procstle implications of global defs falling $* in procs which are not yet selected for linking etc. $* In fact, three lists are rch } ; ( (begin { findprocs } *work := NIL; *procsrch(symtab); *findprocs := work (end { findprocs } ; ( ({ (* Findnebuilt: $* The procs list with all procs and func to be grabbed $* from the various sep segs. $* The local list of rewprocs is called to place new procedures into the (* uprocs work list that are needed to resolve GLOBDEFs, fs in the original segment which must $* ALL be fixed up such as public or private refs in a unit seg. $* The other list (* SEPPREFs, and SEPFREFs. The other list is traversed and (* for each element whose defining proc has not been added (*  procsrch(symtab); .{ if we get here then didnt find it } .error('missing proc') ,end { findnadd } ; , (begin { findnewprocs,* not be found, an error is given. ,} , ,procedure sepsrch(oktype: litypes); .var syp: symp; 2sp: segp; ,begin .sp :=  } *wp := other; { assume only globref, seppref, sepfref in list } *while wp <> NIL do ,begin .if wp^.defproc = NIL theseplist; .while sp <> NIL do 0begin 2syp := symsrch(inlist^.refsym^.entry.name, Aoktype, sp^.symtab); 2if syp <> NIL then n 0begin { find proc/func needed } 2if wp^.refsym^.entry.litype = GLOBREF then 4pnum := wp^.defsym^.entry.homeproc 2else { a4begin 6inlist^.defsym := syp; 6inlist^.defseg := sp; 6sp := NIL 4end 2else 4sp := sp^.next 0end ,end { sepsrch } ; , ssume a SEP proc/func } 4pnum := wp^.defsym^.entry.srcproc; 2wp1 := procs; 2while wp1 <> NIL do 4if wp^.defseg = wp1^.defseg,{ ,* Procinsert is called to insert work into the procs ,* list using a special set of sort keys so that copyin- ,* procs then 6if wp1^.defsym^.entry.srcproc = pnum then 8begin { already gonna be linked } :wp^.defproc := wp1; :wp1 := NIL 8end  will run reasonably fast and use the disk ,* efficiently. The procs list is sorted by segment, ,* srcbase keys. The seg o6else 8wp1 := wp1^.next 4else 6wp1 := wp1^.next; 2if wp^.defproc = NIL then { forcibly link it } 4wp^.defproc := findnadd(rdering is dictated by the ,* seplist, so user ASECTS etc will retain their original ,* ordering. ,} , ,procedure procinswp^.defseg^.symtab) 0end; .wp := wp^.next ,end { while } (end { findnewprocs } ; ( ({ (* Resolve removes work items fromert(work: workp); , label 1; .var crnt, prev: workp; 2sp: segp; ,begin , prev := NIL; .sp := seplist; .while sp <> outl inlist, searches symtabs (* for its corresponding definition symbol (error if not found), (* and moves the work item into tist^.defseg do 0if sp = work^.defseg then 2goto 1 0else 2sp := sp^.next; .crnt := outlist; .repeat he output list. Each flavor (* of work item needs some special handling to collect extra (* info related to specific things0if crnt^.defseg = work^.defseg then 2repeat 4if work^.defsym^.entry.place^.srcbase < 7crnt^.defsym^.entry.place^.srcbase th. In general, defsym and (* defseg are filled in. The insert algorithm is special for (* procedure types to make life easen 6goto 1; 2 prev := crnt; 4crnt := crnt^.next; 4if crnt = NIL then 6goto 1 0 until crnt^.defseg <> work^.defseg 0else6if sym^.entry.litype in [SEPPROC, SEPFUNC] then 8if sym^.entry.srcproc = pnum then :begin  NIL then 6while sp <> crnt^.defseg do 8if sp = work^.defseg then  if unitsrch(hostfile, name, seg) = hostfile then @begin { will be found in host } Bdefsym := refsym; Bdefsegnum := seg :goto 1 8else :sp := sp^.next 2end .until crnt = NIL; *1: .if prev = NIL then 0begin 2work^.next := outlist; 2outlist :@end 0 else { "impossible" } @error('unit err') 0end { cases } ; , .wp := inlist; .inlist := wp^.next; .if = work 0end .else 0begin 2work^.next := prev^.next; 2prev^.next := work 0end ,end { procinsert } ; , (begin { resolve }wp^.defsym = NIL then 0with wp^.refsym^.entry do 2begin 4case litype of 6GLOBREF: write('Global '); 6PUBLREF: write('Publ *while inlist <> NIL do ,begin .with inlist^, refsym^.entry do 0case litype of 2GLOBREF: begin @sepsrch(GLOBDEF); @deic '); 4 CONSTREF: write('Const '); 6SEPPREF, 6EXTPROC: write('Proc '); 6SEPFREF, 6EXTFUNC: write('Func ') 4end { casesfproc := NIL >end; 2 2CONSTREF: if hostsp <> NIL then @begin Bdefsym := symsrch(name, CONSTDEF, Phostsp^.symtab); Bdefs } ; 4write(name); 4error(' undefined') 2end .else 0if (wp^.defsym^.entry.litype in [SEPPROC, SEPFUNC]) 0and (outlist <> eg := hostsp @end; 2 2PUBLREF: if hostsp <> NIL then @begin Bdefsym := symsrch(name, PUBLDEF, Phostsp^.symtab); NIL) then 0 procinsert(wp) 0else 2begin 4wp^.next := outlist; 4outlist := wp 2end ,end { while } (end { resolve } ; ( Bdefseg := hostsp @end; 2 2PRIVREF: begin @newoffset := nextbaselc; @nextbaselc := nextbaselc+nwords; @if hostsp <> NI({ (* Refsrch slowly goes through all reference lists in symbols (* which are in the okset to see if any "occur" within theL then Bdefsym := refsym; @defseg := hostsp >end; 2EXTPROC, 2SEPPROC, 2SEPPREF: begin @sepsrch(SEPPROC); @if litype = (* procedures/functions selected to be linked, that is contained (* in procs list. It is assumed that procs is sorted by d SEPPREF then Bdefproc := NIL; @err := FALSE; @if defsym <> NIL then Bif litype = SEPPREF then Derr := defsym^.entry.nparamefseg (* so only the procs between ipl and lpl are searched. s <> nwords Belse Derr := defsym^.entry.nparams <> nparams; @if err then Bbegin Dwrite('Proc ', name); Derror(' param mism(* Any symbols which have any refs in selected procs are given (* work nodes and are placed in the uother list in no certainatch') Bend >end; 2EXTFUNC, 2SEPFUNC, 2SEPFREF: begin @sepsrch(SEPFUNC); @if litype = SEPFREF then Bdefproc := NIL;  (* order so resolve can be called right away. (} ( (procedure refsrch(okset: liset; sp: segp); *var lpl, ipl: workp; .di@err := FALSE; @if defsym <> NIL then Bif litype = SEPFREF then Derr := defsym^.entry.nparams <> nwords Belse Derr := defsyffseg: boolean; . ,{ ,* Checkrefs recursivly searches sym tree to kind names ,* in the okset. When one is found, each of m^.entry.nparams <> nparams; @if err then Bbegin Dwrite('Func ', name); Derror(' param mismatch') Bend >end; 2 2UNITREF:its ref pointers ,* are checked to see if they fall in one of the procs ,* to-be-linked (between ipl & lpl). If so, a new w  .repeat 0diffseg := lpl^.defseg <> ipl^.defseg; 0if not diffseg then 2lpl := lpl^.next .until diffseg or (lpl = NIL); .ch NIL do .begin 0wp^.needsrch := TRUE; 0wp := wp^.next .end; ,sp := seplist; ,while sp <> NIL do .begin 0refsrch([PUBLREFeckrefs(sp^.symtab); .repeat 0ipl^.needsrch := FALSE; 0ipl := ipl^.next .until ipl = lpl ,end (end { refsrch } ; ( ({ , PRIVREF, CONSTREF], sp); 0sp := sp^.next .end; ,resolve(uother, other) *end $end { buildworklists } ;  (* findlocals recursivly searches the main segs symtab to (* place any unresolved things like public refs in unit (* segs ork item ,* is generated and it's put on the uother list. ,} , ,procedure checkrefs(sym: symp); .label 1, 2; .var pl, wp:into the ulocal list so they can be fixed up in (* fixuprefs in addition to the sep proc things. (} ( (procedure findlocals workp; 2i, n, ref: integer; 2rp: refp; ,begin .if sym <> NIL then 0begin 2checkrefs(sym^.llink); 2checkrefs(sym^.rlink);(sym: symp); *var wp: workp; (begin *if sym <> NIL then ,begin .findlocals(sym^.llink); .findlocals(sym^.rlink); .findloc 2checkrefs(sym^.slink); 2with sym^.entry do 4if litype in okset then 6begin 8n := nrefs; 8rp := reflist; 8while rp <> NIals(sym^.slink); .if sym^.entry.litype in [UNITREF, PUBLREF, PRIVREF] then 0begin 2new(wp); 2wp^.refsym := sym; 2wp^.refsegL do :begin  8 then >begin @i := 7; @n := n-8 >end i := n-1; ref := rp^.refs[i]; >pl := ipl; >repeat { search proc list } @if pl^.needsrch then Bwith pl^.defsym^.entry.place^ do Dif begin { buildworklists } &procs := NIL; &local := NIL; &other := NIL; &uprocs := NIL; &ulocal := NIL; &uother := NIL; &wiref < srcbase then Fgoto 2 { terminate proc search } Delse Fif ref < srcbase+length then Hbegin { occurs in proc } Jnew(wp)th seginfo[s]^ do (if segkind <> LINKED then *begin ,sephost := segkind = SEPRTSEG; ,if sephost then .begin 0next := sepli; Jwp^.refsym := sym; Jwp^.refseg := sp; Jwp^.defsym := NIL; Jwp^.defseg := NIL; Jwp^.next := uother; Juother := wp; Jgotst; 0seplist := seginfo[s]; 0uprocs := findprocs([SEPPROC, SEPFUNC], symtab) .end ,else o 1 Hend; @pl := pl^.next >until pl = lpl; :2: >i := i-1  NIL do .begin 0resolve(uprocs, procs); 0sp := seplist; ,end { checkrefs } ; ( (begin { refsrch } *ipl := NIL; *lpl := procs; *while lpl <> NIL do ,if (lpl^.defseg = sp) ,and l0while sp <> NIL do 2begin 4refsrch([GLOBREF, SEPPREF, SEPFREF], sp); 4sp := sp^.next 2end; 0resolve(uother, other); 0findpl^.needsrch then .begin 0ipl := lpl; 0lpl := NIL .end ,else .lpl := lpl^.next; *if ipl <> NIL then ,begin .lpl := ipl;newprocs .end; ,if not sephost then .begin 0findlocals(symtab); 0resolve(ulocal, local) .end; ,wp := procs; ,while wp <>  The linker is made up of three phases:  * Phase1 which open all input files, reads up seg tables  * from them and decides which segments are to be  * linked into the final code file.  * Phase2 reads the linker info for each segment that is  * going to be used, either to select sep procs from  * or copy with modifications i  (******************************************************************) $(* nto output code.  * The main symbol tree are built here, one for each  * code segment.  * Phase3 do *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribues the crunching of code segments into their  * final form by figuring out the procs that need to  * bete this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from t linked in, resolves all references (PUBLREF,  * GLOBREF, etc), patches the code pointed to by their he Institute for Information Systems. *) $(* *) $(******************************************************************) $  {$U-,R+   (UCSD PASCAL SYSTEM ( PROGRAM LINKER (O^ (Written summer '78 by (Roger T. Sumner, IIS ( (Copyright (c) 1978, Regents of (the University of California (  All hope abandon ye who enter here 8-Dante   }   program systemlevel;   const $SYSPROG = 4;   var $syscom: ^integer;  gfiles: array [0..5] of integer; $userinfo: record 0filler: array [0..4] of integer; 0slowterm, stupid: boolean; 0altmode: char; 0gotsym, gotcode: boolean; 0workvid, symvid, codevid: string[7]; 0worktid, symtid, codetid: string[15] .end;  filler: array [0..4] of integer; $syvid, dkvid: string[7];  junk1, junk2: integer; $cmdstate: integer;   {  * oc } $MAXPROC = 160; { max legal procedure number } $MSDELTA = 12; { mark stack size for pub/priv fixup } $  typeGLOBDEF, { global addr location } /PUBLDEF, { BASE var location } /CONSTDEF, { BASE const definition }  $ ${ subranges } ${ --------- } $ $segrange = 0..MAXSEG; { seg table subscript type } $segindex = 0..MAXSEG1; - { proc/func info, assem } 3{ to PASCAL and PASCAL } 3{ to PASCAL interface } /EXTPROC, { EXTERNAL proc to { wish we had const expressions! } $lcrange = 1..MAXLC; { base offsets a la P-code } $icrange = 0..MAXIC; { lebe linked into PASCAL } /EXTFUNC, { " func " " " " " } /SEPPROC, { Separate proc definitgal length for proc/func code } $procrange = 1..MAXPROC; { legit procedure numbers } $ ${ miscellaneous } ion record } /SEPFUNC, { " func " " } /SEPPREF, { PASCAL ref to a sep proc } /SEPFREF); ${ ------------- } $ $alpha = packed array [0..7] of char; $diskblock = packed array [0..511] of 0..255; $codefile = file;  { " ref to a sep func }  $liset = set of litypes; $opformat = (WORD, BYTE, BIG); { instruction operand { trick compiler to get ^file } $filep = ^codefile;  codep = ^diskblock; { space management...non-PASCA field formats } $ $lientry = record { format of link info records } 0name: alpha; 0case litype: litypes of 2SEPPREF, 2L kludge }  ${ link info structures } ${ ---- ---- ---------- } $ $placep = ^placerec; { position in source seg } SEPFREF, 2UNITREF, 2GLOBREF, 2PUBLREF, 2PRIVREF, 2CONSTREF: 8(format: opformat; { how to deal with the refs } $placerec = record / srcbase, destbase: integer; 1length: icrange /end { placerec } ; $ $refp = ^refnode; { in9nrefs: integer; { words following with refs } 9nwords: lcrange; { size of private or nparams } 9reflist: refp);-core version of ref lists } $refnode = record 0next: refp; 0refs: array [0..7] of integer; .end { refnode } ; 0 $litypes  { list of refs after read in }  EXTPROC, 2EXTFUNC, 2SEPPROC, 2SEPFUNC: 8(srcproc: procrange;  * reflists, and writes the final code seg(s).  }   segment procedure linker(iii, jjj: integer);   const $MA= (EOFMARK, { end-of-link-info marker } 3{ ext ref types, designates } 3{ fields to be updated by linker } /UNITXSEG = 15; { max code seg # in code files } $MAXSEG1 = 16; { MAXSEG+1, useful for loop vars } $MASTERSEG = 1; REF, { refs to invisibly used units (archaic?) } /GLOBREF, { refs to external global addrs } /PUBLREF,  { USERHOST segment number # } $FIRSTSEG = 7; { first linker assignable seg # } $MAXFILE = 7; { number of lib fi { refs to BASE lev vars in host } /PRIVREF, { refs to BASE vars, allocated by linker } les we can use } $MAXLC = MAXINT; { max compiler assigned address } $MAXIC = 2400; { max number bytes of code per pr/CONSTREF, { refs to host BASE lev constant } - { defining types, gives } 3{ linker values to fix refs } / dest seg } 2GLOBDEF: 8(homeproc: procrange; { which proc it occurs in } 9icoffset: icrange); { its byte offset in pcode ?codeleng, codeaddr: integer =end { diskinfo } ; $ segname: array [segrange] of alpha; 1segkind: array [segrange} 2PUBLDEF: 8(baseoffset: lcrange); { compiler assign word offset } 2CONSTDEF: 8(constval: integer); { users defined val] of segkinds; 1filler: array [0..143] of integer /end { I5segtbl } ; / $filekind = (USERHOST, USERLIB, SYSTEMLIB); $ $filue } 2EOFMARK: 8(nextlc: lcrange) { private var alloc info } 0end { lientry } ;  ${ symbol table items } ${ ------ einforec = record 4next: finfop; { link to next file thats open } 4code: filep; { pointer to PASCAL file...sneaky----- ----- } $ $symp = ^symbol; $symbol = record /llink, rlink, { binary subtrees for diff names } /slink: symp! } $ fkind: filekind; { used to validate the segkinds } 4segtbl: I5segtbl { disk seg table w/ source inf; { same name, diff litypes } /entry: lientry { actual id information } -end { symbol } ; $ o } 2end { fileinforec } ; 2   var $hostfile, { host file info ptr, its next = libfiles } $libfiles: finfop; ${ segment information } ${ ------- ----------- } $ $segkinds =(LINKED, { no work needed, executable as is } /HOST{ list of lib files, user and system } $ $seplist: segp; { list of sep segs to search through } $reflitypes: liset; { tSEG, { PASCAL host program outer block } /SEGPROC, { PASCAL segment procedure, not host } /UNITSEG, {hose litypes with ref lists } $ $talkative, $useworkfile: boolean; $ $errcount: integer; $heapbase: ^integer; $ $hostsp: library unit occurance/reference } /SEPRTSEG); { library separate proc/func TLA segment } $ $finfop = ^fileinforec;  segp; { ptr to host prog outer block }  { forward type dec } $ $segp = ^segrec; { this structure provides access to all } $segrec = record $nextbaselc: lcrange; { next base offset for private alloc } $seginfo: array [segrange] of segp; { seg is avai { info for segs to be linked to/from } /srcfile: finfop; { source file of segment } /srcseg: segrange; { solable if NIL } $nextseg: segindex; { next slot in seginfo available } $ $mapname: string[40]; $ $f0, f1, furce file seg # } /symtab: symp; { symbol table tree } /case segkind: segkinds of 1SEPRTSEG: 1 (next: segp)2, f3, $f4, f5, f6, f7, { input files with lurking pntrs } $code: codefile; { output  { used for library sep seg list } -end { segrec } ; $ ${ host/lib file access info } ${ ---- --- ---- ------ ---- } $ code file, *system.wrk.code } $ $  {  * Print an error message and bump  * the error counter.  }   procedure error(ms { the procnum in source seg } 9nparams: integer; { words passed/expected } 9place: placep); { position in source/$I5segtbl = record { first full block of all code files } 1diskinfo: array [segrange] of =record   useleft: boolean;  begin "newsym^.llink := NIL; "newsym^.rlink := NIL; "newsym^.slink := NIL; "if symtab = NIL then en.  }   function unitsrch(fp: finfop; var name: alpha; var seg: segrange): finfop; "label 1;  var s: segindex;  begin $symtab := newsym "else $begin { search symtab and add newsym } &syp := symtab; &repeat (lastsyp := syp; (if syp^.entry.nseg := 0; "while fp <> NIL do $begin &with fp^.segtbl do (for s := 0 to MAXSEG do *if segname[s] = name then ,if segkind[sg: string);  var ch: char;  begin "writeln(msg); "repeat $write('Type (continue), (terminate)'); $read(keyboardame > newsym^.entry.name then *begin syp := syp^.llink; useleft := TRUE end (else *if syp^.entry.name < newsym^.entry.name th, ch); $if ch = userinfo.altmode then &exit(linker) "until ch = ' '; "errcount := errcount+1  end { error } ;   {  * Ren ,begin syp := syp^.rlink; useleft := FALSE end *else { equal } ,begin { add into sideways list } .newsym^.slink := syp^.soutines to access object code segments. There  * is subtle business involving byte flipping with  * the 16-bit operations. link; .syp^.slink := newsym; .lastsyp := NIL; { already added flag } .syp := NIL { stop repeat loop } ,end &un This needs more research  * when the time comes.  }  {$R-}   function fetchbyte(cp: codep; offset: integer): integer; til syp = NIL; &if lastsyp <> NIL then (begin { add to bottom of tree } *if useleft then ,lastsyp^.llink := newsym *else , begin "fetchbyte := cp^[offset]  end { fetchbyte } ;   function fetchword(cp: codep; offset: integer): integer;  var ilastsyp^.rlink := newsym (end $end { symtab <> NIL }  end { entersym } ;   {  * Look up name in symtab tree and return p: integer;  begin "moveleft(cp^[offset], i, 2); "{ byte swap i } "fetchword := i  end { fetchword } ;   procedure storebointer  * to it. Oktype restricts what litype is  * acceptable. NIL is returned if name not found.  }   function symsryte(val: integer; cp: codep; offset: integer);  begin "cp^[offset] := val  end { storebyte } ;   procedure storeword(val: ch(var name: alpha; oktype: litypes; symtab: symp): symp;  var syp: symp;  begin  symsrch := NIL; "syp := symtab; integer; cp: codep; offset: integer);  begin "{ byte swap val } "moveleft(val, cp^[offset], 2)  end { storeword } ; $  {$R"while syp <> NIL do $if syp^.entry.name > name then &syp := syp^.llink $else &if syp^.entry.name < name then (syp := syp^+}   {  * Enter newsym in symtab tree. The tree is binary for  * different names and entries with the same name are ente.rlink &else { equal name } (if syp^.entry.litype <> oktype then *syp := syp^.slink (else { found! } *begin symsrch := syp;red  * onto sideways links (slink). No check is made for dup  * entry types, caller must do that. Nodes on slink will  *  syp := NIL end  end { symsrch } ;   {  * Search for the occurance of the unit segment  * given by name in the list of f always have NIL rlink and llink.  }   procedure entersym(newsym: symp; var symtab: symp); "var syp, lastsyp: symp;  iles in fp.  * Return the file and segment number in seg.  * NIL is returned for non-existant units and  * an error is giv he Institute for Information Systems. *) $(* *) $(******************************************************************) $  {  * Phase 1 opens host and library files and  * reads O^in seg tables. All fields are verified  * and the hostfile/libfiles file list is built.  * The prototype final seg table is set up in  * seginfo[*] from the host file and the sep seg  * list is set up for searching in later phases.  }   procedure phase1;  ${ $* Build file list opens input code files and reads segtbls. ] = UNITSEG then .goto 1; &fp := fp^.next $end; "write('Unit ', name); "error(' not found'); "s := 0;  1: "seg := s; "unitsrch := fp  end { unitsrch } ;   {  * Alphabetic returns TRUE if name contains all legal  * characters for PASCAL identifiers. Used to validate  * segnames and link info entries.  }   function alphabetic(var name: alpha): boolean; "label 1; "var i: integer;  begin "alphabetic := FALSE; "for i := 0 to 7 do $if not (name[i] in ['A'..'Z', '0'..'9', ' ', '_']) then &goto 1; "alphabetic := TRUE;  1:  end { alphabetic } ;   {  * Getcodep is a sneaky routine to point codep's anywhere  * in memory. It violates Robot's Rules of Order, but is  * very useful for dealing with t  (******************************************************************) $(* he variable size segments  }   function getcodep(memaddr: integer): codep;  var r: record +case boolean of -TRUE: (i:  *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribuinteger); -FALSE: (p: codep) +end;  begin  r.i := memaddr; "getcodep := r.p  end { getcodep } ;  te this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from t et of segkinds; ( ,{ ,* Getfilep returns a pointer to a file using unspeakable ,* methods, but the ends justify the means.error('bad diskinfo'); 6if not (segkind[s] in goodkinds) then 8error('bad seg kind'); 6if not alphabetic(segname[s]) then 8e ,} , ,function getfilep(var f: codefile): filep; .var a: array [0..0] of filep; ,begin .{$R-} .getfilep := a[-1]; .{$R+rror('bad seg name'); 6if errcount > errs then 8s := MAXSEG; 6s := s+1 4until s > MAXSEG; 2if alllinked and (kind = USERHOS} ,end { getfilep } ; , (begin { setupfile } *case num of ,0: cp := getfilep(f0); ,1: cp := getfilep(f1); T) then 4begin 6write('All segs linked'); 6exit(linker) 4end; 2if errcount = errs then 4hostfile := fp { ok fil,2: cp := getfilep(f2); ,3: cp := getfilep(f3); ,4: cp := getfilep(f4); ,5: cp := getfilep(f5); ,6: cp := getfilep(f6)e...link in } 0end ,end (end { setupfile } ; ( $begin { buildfilelist } &if talkative then (begin *for i := 1 to 7 do ,; ,7: cp := getfilep(f7) *end { cases } ; *reset(cp^, title); *if IORESULT <> 0 then ,if title <> 'in workspace' then .bewriteln; *writeln('Linker [I.5]') (end; &useworkfile := cmdstate <> SYSPROG; &with userinfo do (if useworkfile then *begingin 0insert('.CODE', title, length(title)+1); 0reset(cp^, title) .end; *if IORESULT <> 0 then ,begin .insert('No file ', t ,if gotcode then .fname := concat(codevid, ':', codetid) ,else .fname := 'in workspace'; ,setupfile(0, USERHOST, fname); itle, 1); .error(title); .if kind <> USERHOST then 0errcount := errcount-1 ,end *else ,begin { file open ok } .if talkati,setupfile(1, SYSTEMLIB, '*SYSTEM.LIBRARY') *end (else & begin ,write('Host file? '); ,readln(fname); ,if fname = '' tve then 0writeln('Opening ', title); .new(fp); .fp^.next := hostfile; .fp^.code := cp; .fp^.fkind := kind; .if blockread(chen .if gotcode then 0fname := concat(codevid, ':', codetid) .else 0fname := 'in workspace'; ,setupfile(0, USERHOST, fname)$* The var hostfile is set up as head of linked list of file $* info recs. The order of these files determines how id's $*p^, fp^.segtbl, 1, 0) <> 1 then 0error('segtbl read err') .else 0begin { now check segtbl values } 2s := 0; alllinked := TRU will be searched for. Note that libfiles points at the $* list just past the host file front entry. $} $ $procedure buiE; 2errs := errcount; 2if kind = USERHOST then 4goodkinds := [LINKED,SEGPROC,SEPRTSEG,HOSTSEG,UNITSEG] 2else 4goodkinds := ldfilelist; &label 1; &var f: 0..MAXFILE; *i: integer; *p, q: finfop; *fname: string[40]; $ ({ (* Setupfile opens file [LINKED,UNITSEG,SEPRTSEG]; 2with fp^.segtbl do 4repeat 6alllinked := alllinked and (segkind[s] = LINKED); and enters new finfo rec in (* hostfile list. Segtbl is read in and validated. (} ( (procedure setupfile(num: integer; kin6if (diskinfo[s].codeleng = 0) 6and (segkind[s] <> LINKED) then 8if (kind <> USERHOST) 8or (segkind[s] <> UNITSEG) then :erd: filekind; title: string); *var errs: integer; .s: segindex; .cp: filep; .fp: finfop; .alllinked: boolean; .goodkinds: sror('funny code seg'); 6if (diskinfo[s].codeleng < 0) 6or (diskinfo[s].codeaddr < 0) 6or (diskinfo[s].codeaddr > 300) then 8 , fname) .end; (1: * write('Map name? '); ,readln(mapname); ,if mapname <> '' then .if mapname[length(mapname)] = '.' the ; .if errs = errcount then 0seginfo[s] := sp .else 0seginfo[s] := NIL ,end; $ &{ now find first assignable seg } & &fon 0delete(mapname, length(mapname), 1) .else 0insert('.TEXT', mapname, length(mapname)+1) *end; , &{ now reverse list so hr s := FIRSTSEG to MAXSEG do (if seginfo[s] = NIL then *goto 1; &s := MAXSEG1; $1: &nextseg := s; &if seginfo[MASTERSEG] =ost is } &{ first and syslib is last } & &p := hostfile; hostfile := NIL; &repeat (q := p^.next; (p^.next := hostfile;  NIL then (error('wierd host') $end { buildseginfo } ; $ ${ $* Buildseplist searches through libraries and adds onto $* (hostfile := p; (p := q &until p = NIL; &libfiles := hostfile^.next; $end { buildfilelist } ; $ ${ a global list of sep segs that are to be searched $* for procs and globals. They are initially build in $* the reverse orde$* Buildseginfo initializes the seginfo table from $* the host prototype seg table. All legal states $* are checked, and r, then reversed again so searches $* will go in the order the files were specified. $} $ $procedure buildseplist; &var spimported units found. This $* leaves a list of all segs to finally appear in $* the output code file. $} $ $procedure bu, p, q: segp; *fp: finfop; *s: segindex; $begin &fp := libfiles; &while fp <> NIL do (begin *for s := 0 to MAXSEG do ,ifildseginfo; &label 1; &var s: segindex; *errs: integer; *sp: segp; $begin &with hostfile^.segtbl do (for s := 0 to MAXSEG fp^.segtbl.segkind[s] = SEPRTSEG then .begin 0new(sp); 0sp^.next := seplist; 0sp^.srcfile := fp; 0sp^.srcseg := s;  do *if (segkind[s] = LINKED) *and (diskinfo[s].codeleng = 0) then ,seginfo[s] := NIL { not in use } *else ,begin { do so0sp^.symtab := NIL; 0sp^.segkind := SEPRTSEG; 0sp^.next := seplist; 0seplist := sp .end; *fp := fp^.next (end; & &{ nowmething with seg } .errs := errcount; .new(sp); .sp^.srcfile := hostfile; .sp^.srcseg := s; .sp^.symtab := NIL; .sp^.segki reverse the list to maintain original order } & &p := seplist; seplist := NIL; &while p <> NIL do (begin *q := p^.next; *nd := segkind[s]; .case sp^.segkind of 0SEGPROC, 0LINKED: ; { nothing to check! } 0 0HOSTSEG: if s <> MASTERSEG then p^.next := seplist; *seplist := p; *p := q (end $end { buildseplist } ; $  begin { phase1 } " "{ initialize globals } "=error('bad host seg') ;else =if hostsp <> NIL then = error('dup host seg') =else ?hostsp := sp; 0 0SEPRTSEG: if s = M "hostfile := NIL; "libfiles := NIL; "hostsp := NIL; "seplist := NIL; "reflitypes := [UNITREF, GLOBREF, PUBLREF, 1PRIVREF,; ,if errcount > 0 then .exit(linker); { no host! } ,for f := 1 to MAXFILE do .begin 0write('Lib file? '); 0readln(fname);ASTERSEG then =sp^.next := NIL ;else =begin { put into seplist } ?sp^.next := seplist; ?seplist := sp; ?sp := NIL =end;  0if fname = '' then 2goto 1; 0if fname = '*' then 2setupfile(f, SYSTEMLIB, '*SYSTEM.LIBRARY') 0else 2setupfile(f, USERLIB0 0UNITSEG: if diskinfo[s].codeleng = 0 then =sp^.srcfile := unitsrch(libfiles, Tsegname[s], Tsp^.srcseg) .end { cases }   (******************************************************************) $(*  9: S := 'vol not found'; 10: S := 'file not found'; 11: S := 'dup dir entry'; 12: S := 'file already open';  CONSTREF, 1SEPPREF, SEPFREF]; "errcount := 0; "nextbaselc := 3; "mapname := ''; "talkative := not userinfo.slowterm; "mar *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribuk(heapbase); "unitwrite(3, heapbase^, 35); " "{ build list of input files } " "buildfilelist; "if errcount > 0 then $exitte this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from t(linker); " "{ init basic seg info table } " "buildseginfo; "if errcount > 0 then $exit(linker); $ "{ finally build sep he Institute for Information Systems. *) $(* *) $(****seg list } " "buildseplist; "if errcount > 0 then $exit(linker)  end { phase1 } ;  **************************************************************) $ SEGMENT PROCEDURE USERPROGRAM(INPUT,OUTPUT: FIBP); BEGIN FWRIO^TELN(SYSTERM^); PL := 'No user program'; FWRITESTRING(SYSTERM^,PL,0) END (*USERPROGRAM*) ; SEGMENT PROCEDURE DEBUGGER; BEGIٝN FWRITELN(SYSTERM^); PL := 'No debugger in system'; FWRITESTRING(SYSTERM^,PL,0) END (*DEBUGGER*) ; SEGMENT PROCEDURE PRINTERROR(XEQERR,IORSLT: INTEGER); VAR S: STRING[40]; BEGIN S := 'Unknown run-time error'; CASE XEQERR OF  1: S := 'Value range error'; 2: S := 'No proc in seg-table'; 3: S := 'Exit from uncalled proc'; 4: S := 'Stack overflow'; 5: S := 'Integer overflow'; 6: S := 'Divide by zero'; 7: S := 'NIL pointer reference'; 8: S := 'Program interrupted by user'; 9: S := 'System IO error'; 10: BEGIN S := 'unknown cause'; CASE IORSLT OF 1: S := 'parity (CRC)'; 2: S := 'illegal unit #'; 3: S := 'illegal IO request'; 4: S := 'data-com timeout'; 5: S := 'vol went off-line'; 6: S := 'file lost in dir'; 7: S := 'bad file name'; 8: S := 'no room on vol';  EGIN XEQERR := 0; IORSLT := INOERROR; BUGSTATE :=0 END; TITLE := '*SYSTEM.MISCINFO' ; RESET( F, TITLE ); OF CHAR; SET2: CHARSET; FILLER2: PACKED ARRAY [0..63] OF CHAR; TRITON: ARRAY [0..63,0..3] OF INTEGER END (*CHA IF IORESULT = ORD(INOERROR) THEN BEGIN IF NOT EOF( F ) THEN WITH SYSCOM^, F^ DO BEGIN MISCINFO := MSYSCOM.MRBUF*) ; LFIB: FIB; BEGIN FINIT(LFIB,NIL,-1); LTITLE := '*SYSTEM.CHARSET'; FOPEN(LFIB,LTITLE,TRUE,NIL); IF LISCINFO; ,CRTTYPE := MSYSCOM.CRTTYPE; ,CRTCTRL := MSYSCOM.CRTCTRL; CRTINFO := MSYSCOM.CRTINFO; ,FILLER[0] := CHR(SYSCOM^FIB.FISOPEN THEN BEGIN UNITWRITE(3,TRIX,128); IF IORESULT = ORD(INOERROR) THEN BEGIN WITH LFIB.FHEADER DO .CRTCTRL.FILLCOUNT); ,FILLCHAR( FILLER[1], SYSCOM^.CRTCTRL.FILLCOUNT, CHR(0) ); END; CLOSE( F, NORMAL ) END; END (*IBEGIN DOTRITON := DLASTBLK-DFIRSTBLK > 4; UNITREAD(LFIB.FUNIT,CHARBUF,SIZEOF(CHARBUF),DFIRSTBLK) END;  13: S := 'file not open'; 14: S := 'bad input format' END (*IO ERRORS*) ; INSERT('IO error: ',S,1) END; 11NITSYSCOM*) ; PROCEDURE INITUNITABLE; VAR LUNIT: UNITNUM; LDIR: DIRP; BEGIN FOR LUNIT := 0 TO MAXUNIT DO WITH: S := 'Unimplemented instruction'; 12: S := 'Floating point error'; 13: S := 'String overflow';  UNITABLE[LUNIT] DO BEGIN UVID := ''; UISBLKD := LUNIT IN [4,5,9..12]; IF UISBLKD THEN UEOVBLK := MMAXINT; UNITCLEAR(L 14: S := 'Programmed HALT'; 15: S := 'Programmed break-point' END (*XEQ ERRORS*) ; WRITELN(OUTPUT,S); WITH SYSCOM^UNIT); END; UNITABLE[1].UVID := 'CONSOLE'; UNITABLE[2].UVID := 'SYSTERM'; SYVID := ''; LUNIT := VOLSEARCH(SYVID.BOMBP^ DO WRITE(OUTPUT,'S# ',MSSEG^[0] MOD 256, ', P# ',MSJTAB^[0] MOD 256, ', I# ',MSIPC-(ORD(MSJTAB)-2-MSJTAB^[-1]),TRUE,LDIR); SYVID := UNITABLE[SYSCOM^.SYSUNIT].UVID; IF LENGTH(SYVID) = 0 THEN HALT; IF JUSTBOOTED THEN DKVID := SY) END (*PRINTERROR*) ; SEGMENT PROCEDURE INITIALIZE; VAR DOTRITON,JUSTBOOTED: BOOLEAN; LTITLE: STRING[40]; MONTHS: ARRAVID; LUNIT := VOLSEARCH(SYVID,FALSE,LDIR); IF LDIR = NIL THEN HALT; THEDATE := LDIR^[0].DLASTBOOT; Y [0..15] OF STRING[3]; &DISPLAY: ARRAY [0..79,0..19] OF INTEGER; (*FOR TRITON*) STKFILL: ARRAY [0..1199] OF INTEGER;  UNITCLEAR(6); IF IORESULT = ORD(INOERROR) THEN UNITABLE[6].UVID := 'PRINTER'; UNITCLEAR(8); IF IORESULT = PROCEDURE INITSYSCOM; VAR TITLE: STRING; F: FILE OF MISCINFOREC; BEGIN (* FIRST SOME GLOBALS *) FILLER[0] ORD(INOERROR) THEN UNITABLE[8].UVID := 'REMOTE'; END (*INITUNITABLE*) ; PROCEDURE INITCHARSET; TYPE CHARSET= ARRAY := CHR(SYSCOM^.CRTCTRL.FILLCOUNT); FILLCHAR( FILLER[1], SYSCOM^.CRTCTRL.FILLCOUNT, CHR(0) ); DEBUGINFO := NIL; IPOT[32..127] OF PACKED ARRAY [0..9] OF 0..255; VAR I: INTEGER; TRIX: RECORD CASE BOOLEAN OF TRUE: (CHARADDR: IN[0] := 1; IPOT[1] := 10; IPOT[2] := 100; IPOT[3] := 1000; IPOT[4] := 10000; DIGITS := ['0'..'9']; WITH SYSCOM^ DO BTEGER); FALSE: (CHARBUFP: ^ CHAR) END; CHARBUF: RECORD SET1: CHARSET; FILLER1: PACKED ARRAY [0..63]  (*BASIC FILE AND HEAP SETTUP*) SYSCOM^.GDIRP := NIL; (* MUST PRECEDE THE FIRST "NEW" EXECUTED *) NEW(SWAPFIB,TRUE,FALSE)YSCOM^.MISCINFO.STUPID END END (*INITWORKFILE*) ; PROCEDURE INITFILES; BEGIN FCLOSE(SWAPFIB^,CNORMAL); FCLO; FINIT(SWAPFIB^,NIL,-1); NEW(INPUTFIB,TRUE,FALSE); NEW(LWINDOW); FINIT(INPUTFIB^,LWINDOW,0); SE(USERINFO.SYMFIBP^,CNORMAL); FCLOSE(USERINFO.CODEFIBP^,CNORMAL); FCLOSE(INPUTFIB^,CNORMAL); FCLOSE(OUTPUTFIB^,CNOR NEW(OUTPUTFIB,TRUE,FALSE); NEW(LWINDOW); FINIT(OUTPUTFIB^,LWINDOW,0); NEW(SYSTERM,TRUE,FALSE); NEW(LWINDOW); FMAL); LTITLE := 'CONSOLE:'; FOPEN(INPUTFIB^,LTITLE,TRUE,NIL); FOPEN(OUTPUTFIB^,LTITLE,TRUE,NIL); IF JUSTBOOTED TINIT(SYSTERM^,LWINDOW,0); GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB; WITH USERINFO DO BEGIN NEW(SYMFIBP,TRUE,HEN BEGIN LTITLE := 'SYSTERM:'; FOPEN(SYSTERM^,LTITLE,TRUE,NIL) END; GFILES[0] := INPUTFIB; GFILES[1] := OUFALSE); FINIT(SYMFIBP^,NIL,-1); NEW(CODEFIBP,TRUE,FALSE); FINIT(CODEFIBP^,NIL,-1) END; MARK(EMPTYHEAP) END (*INITHETPUTFIB; GFILES[2] := SYSTERM; GFILES[3] := NIL; GFILES[4] := NIL; GFILES[5] := NIL; END (*INITFILES*) ; AP*) ; PROCEDURE INITWORKFILE; BEGIN WITH USERINFO DO BEGIN (*INITIALIZE WORK FILES ETC*) ERRNUM := 0; ERRBLK :=BEGIN (*INITIALIZE*) JUSTBOOTED := EMPTYHEAP = NIL; DOTRITON := FALSE; MONTHS[ 0] := '???'; MONTHS[ 1] := 'Jan'; MONTHS[ 0; ERRSYM := 0; IF JUSTBOOTED THEN BEGIN SYMTID := ''; CODETID := ''; WORKTID := ''; SYMVID := SYVID; CODEVID :=  2] := 'Feb'; MONTHS[ 3] := 'Mar'; MONTHS[ 4] := 'Apr'; MONTHS[ 5] := 'May'; MONTHS[ 6] := 'Jun'; MONTHS[ 7] := 'Jul'; MON TRIX.CHARADDR := 512-8192; (*UNIBUS TRICKYNESS!*) FOR I := 32 TO 127 DO BEGIN MOVERIGHT(CHARBUF.SET1[I],TRIX.SYVID; WORKVID := SYVID END; IF LENGTH(SYMTID) > 0 THEN LTITLE := CONCAT(SYMVID,':',SYMTID) ELSE LTITLE := '*SCHARBUFP^,10); TRIX.CHARADDR := TRIX.CHARADDR+16 END; TRIX.CHARADDR := 512-6144; FOR I := 32 TO 127 DO YSTEM.WRK.TEXT'; FOPEN(SYMFIBP^,LTITLE,TRUE,NIL); GOTSYM := SYMFIBP^.FISOPEN; IF GOTSYM THEN BEGIN SYMVID := SYMFIB BEGIN MOVERIGHT(CHARBUF.SET2[I],TRIX.CHARBUFP^,10); TRIX.CHARADDR := TRIX.CHARADDR+16 END; UNITABLE[3].UVID := P^.FVID; SYMTID := SYMFIBP^.FHEADER.DTID END; FCLOSE(SYMFIBP^,CNORMAL); IF LENGTH(CODETID) > 0 THEN 'GRAPHIC'; UNITWRITE(3,I,0) END END ELSE SYSCOM^.MISCINFO.HAS8510A := FALSE; IF DOTRITON THEN  LTITLE := CONCAT(CODEVID,':',CODETID) ELSE LTITLE := '*SYSTEM.WRK.CODE'; FOPEN(CODEFIBP^,LTITLE,TRUE,NIL);BEGIN (*INITIALIZE DISPLAY ARRAY*) FILLCHAR(DISPLAY,SIZEOF(DISPLAY),0); FOR I := 0 TO 63 DO MOVELEFT(CHARBUF.TRITON[I],DISP GOTCODE := CODEFIBP^.FISOPEN; IF GOTCODE THEN BEGIN CODEVID := CODEFIBP^.FVID; CODETID := CODEFIBP^.FHEADER.DTID ELAY[I,10],8) END; FCLOSE(LFIB,CNORMAL) END (*INITCHARSET*) ; PROCEDURE INITHEAP; VAR LWINDOW: WINDOWP; BEGIN ND; FCLOSE(CODEFIBP^,CNORMAL); ALTMODE := SYSCOM^.CRTINFO.ALTMODE; SLOWTERM := SYSCOM^.MISCINFO.SLOWTERM; STUPID := S SCREEN; WRITELN(OUTPUT); IF JUSTBOOTED THEN BEGIN IF DOTRITON THEN BEGIN (*ASSUME DATA MEDIA SCREEN*) UNITREAD(CODEFIBP^.FUNIT,SEGTBL,SIZEOF(SEGTBL), CODEFIBP^.FHEADER.DFIRSTBLK); IF IORESULT <> ORD(INOERROR) THEN BEGIN WRITE(OUTPUT,CHR(30),CHR(32),CHR(41)); UNITWRITE(3,DISPLAY[-80],23) END; WRITELN(OUTPUT,'Welcome ', WRITE(OUTPUT,'Bad block #0'); GOTO 1 END; WITH SEGTBL DO FOR LSEG := 0 TO MAXSEG DO IF NOT (SSYVID,', to'); IF DOTRITON THEN WRITELN(OUTPUT); WRITELN(OUTPUT,'U.C.S.D. Pascal System I.5'); EGKIND[LSEG] IN [LINKED..SEPRTSEG]) THEN BEGIN { PRE I.5 CODE...FIX UP! } FILLCHAR(SEGKIND, SIZEOF(SEGKIND), ORD(LINKED)); IF DOTRITON THEN WRITELN(OUTPUT); WITH THEDATE DO WRITE(OUTPUT,'Current date is ',DAY,'-',MONTHS[MONTH],'-',YEAR)  FILLCHAR(FILLER, SIZEOF(FILLER), 0); UNITWRITE(CODEFIBP^.FUNIT, SEGTBL, SIZEOF(SEGTBL), CODEFIBP^.FHEADER.DFIRSTBLK END ELSE WRITE(OUTPUT,'System re-initialized') END (*INITIALIZE*) ; SEGMENT FUNCTION GETCMD(LASTST: CMDSTATE): CMDSTA) END; WITH SEGTBL DO FOR LSEG := 0 TO MAXSEG DO IF SEGKIND[LSEG] <> LINKED THEN BEGIN IF OKTOLINK THETE; CONST ASSEMONLY = LINKANDGO; "VAR CH: CHAR; BADCMD: BOOLEAN; PROCEDURE RUNWORKFILE(OKTOLINK, RUNONLY: BOOLEAN); FON BEGIN WRITELN(OUTPUT,'Linking...'); FCLOSE(CODEFIBP^, CNORMAL); RWARD; FUNCTION ASSOCIATE(TITLE: STRING; OKTOLINK, RUNONLY: BOOLEAN): BOOLEAN; LABEL 1; VAR RSLT: IORSLTWD; LSEG: SEG IF ASSOCIATE('*SYSTEM.LINKER', FALSE, FALSE) THEN BEGIN IF RUNONLY THEN GETCMD := LINKANDGO ELSE GETCMD := LRANGE; SEGTBL: RECORD DISKINFO: ARRAY [SEGRANGE] OF SEGDESC; SEGNAME: ARRAY [SEGRANGE] OF PACKED ARRAY [0..7] INKDEBUG; EXIT(GETCMD) END END ELSE IF NOT (LASTST IN [LINKANDGO, LINKDEBUG]) THEN 2 WRITE(OUTPUT,'Must LOF CHAR; SEGKIND: ARRAY [SEGRANGE] OF (LINKED,HOSTSEG,SEGPROC,UNITSEG,SEPRTSEG); FILLER: ARRAY [0..143] OF INTEG(ink first'); GOTO 1 END; FOR LSEG := 1 TO MAXSEG DO IF (LSEG = 1) OR (LSEG >= 7) THEN WITH SEGTABLE[LSEER END { SEGTBL } ; BEGIN ASSOCIATE := FALSE; FOPEN(USERINFO.CODEFIBP^,TITLE,TRUE,NIL); RSLT := SYSCOM^.IORSLT; G],SEGTBL.DISKINFO[LSEG] DO BEGIN CODEUNIT := CODEFIBP^.FUNIT; CODEDESC.CODELENG := CODELENG; CODEDESC.DISKADDR := DISTHS[ 8] := 'Aug'; MONTHS[ 9] := 'Sep'; MONTHS[10] := 'Oct'; MONTHS[11] := 'Nov'; MONTHS[12] := 'Dec'; MONTHS[13] := '???'; IF RSLT <> INOERROR THEN BEGIN IF TITLE <> '*SYSTEM.STARTUP' THEN *IF RSLT = IBADTITLE THEN  MONTHS[14] := '???'; MONTHS[15] := '???'; IF JUSTBOOTED THEN INITHEAP ELSE RELEASE(EMPTYHEAP); INITUNITABLE; (*AND THEDAT,WRITE(OUTPUT,'Illegal file name') *ELSE ,WRITE(OUTPUT,'No file ',TITLE); (GOTO 1 END; WITH USERINFO,SYSCOM^ DO E*) INITFILES; INITWORKFILE; IF SYSCOM^.MISCINFO.HAS8510A THEN INITCHARSET; INITSYSCOM; (*AND SOME GLOBALS*) CLEAR IF CODEFIBP^.FHEADER.DFKIND <> CODEFILE THEN BEGIN WRITE(OUTPUT,TITLE,' not code'); GOTO 1 END ELSE BEGIN  KADDR+ CODEFIBP^.FHEADER.DFIRSTBLK END END; ASSOCIATE := TRUE; 1: FCLOSE(USERINFO.CODEFIBP^,CNORMAL) END (*ASSOCIRBLK > 0 THEN BEGIN CLEARSCREEN; WRITELN(OUTPUT); IF ASSOCIATE('*SYSTEM.EDITOR', FALSE, FALSE) THEN BEGIN GETCMD :ATE*) ; PROCEDURE STARTCOMPILE(NEXTST: CMDSTATE); LABEL 1; VAR TITLE: STRING[40]; BEGIN IF NEXTST = ASSEMONLY T= SYSPROG; EXIT(GETCMD) END END END ELSE BEGIN GOTCODE := TRUE; CODEVID := CODEFIBP^.FVID; CODETID := CODEFIBHEN &WRITE(OUTPUT,'Assembling') $ELSE &WRITE(OUTPUT,'Compiling'); $WRITELN(OUTPUT,'...'); $IF NEXTST = ASSEMONLY THEN &TITP^.FHEADER.DTID; FCLOSE(CODEFIBP^,CLOCK); IF LASTST IN [COMPANDGO,COMPDEBUG] THEN RUNWORKFILE(TRUE, LASTST = COMPANDGLE := '*SYSTEM.ASSMBLER' $ELSE $ TITLE := '*SYSTEM.COMPILER'; $IF ASSOCIATE(TITLE, FALSE, FALSE) THEN &WITH USERINFO DO O) END END (*FINISHCOMPILE*) ; PROCEDURE EXECUTE; VAR TITLE: STRING[255]; BEGIN WRITE(OUTPUT,'Execute'); IF (BEGIN ,IF GOTSYM THEN .TITLE := CONCAT(SYMVID,':',SYMTID) ,ELSE .BEGIN 0IF NEXTST = ASSEMONLY THEN 2WRITE(OUTPUT, 'AssemNOT SYSCOM^.MISCINFO.SLOWTERM THEN WRITE(OUTPUT,' what file'); WRITE(OUTPUT,'? '); READLN(TITLE); IF LENGTH(TITLE)ble') 0ELSE 2WRITE(OUTPUT, 'Compile'); 0WRITE(OUTPUT,' what text? '); 0READLN(INPUT, TITLE); IF TITLE = '' THEN GOTO 1;  > 0 THEN BEGIN IF TITLE[LENGTH(TITLE)] = '.' THEN DELETE(TITLE,LENGTH(TITLE),1) ELSE INSERT('.CODE',TITLE,LENGTH(INSERT('.TEXT', TITLE, LENGTH(TITLE)+1); GOTCODE := FALSE .END; ,FOPEN(SYMFIBP^,TITLE,TRUE,NIL); ,IF IORESULT <> ORD(INOERRTITLE)+1); IF ASSOCIATE(TITLE, FALSE, FALSE) THEN BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END END END (*EXECUTE*) ; OR) THEN .BEGIN 0WRITE(OUTPUT,'Can''t find ', TITLE); 0GOTSYM := FALSE; GOTO 1 .END; ,TITLE := '*SYSTEM.SWAPDISK'; ,FOPEN PROCEDURE RUNWORKFILE; BEGIN WITH USERINFO DO IF GOTCODE THEN BEGIN CLEARSCREEN; IF ASSOCIATE(CONCAT(CODEVID,(SWAPFIB^,TITLE,TRUE,NIL); ,TITLE := '*SYSTEM.WRK.CODE[*]'; ,FOPEN(CODEFIBP^,TITLE,FALSE,NIL); ,IF IORESULT <> ORD(INOERROR) ':',CODETID), OKTOLINK, RUNONLY) THEN BEGIN WRITELN(OUTPUT,'Running...'); IF RUNONLY THEN GETCMD := SYSPROG THEN .BEGIN 0WRITE(OUTPUT,'Code open error!'); 0GOTO 1 .END; ,ERRNUM := 0; ERRBLK := 0; ERRSYM := 0; ,IF NEXTST = ASSEMONELSE GETCMD := DEBUGCALL; EXIT(GETCMD) END; IF NOT (LASTST IN [LINKANDGO, LINKDEBUG]) THEN *GOTCODE := FALSE ELY THEN .NEXTST := COMPONLY; ,GETCMD := NEXTST; EXIT(GETCMD) (END; "1: END (*STARTCOMPILE*) ; PROCEDURE FINISHCOMPILE; ND ELSE IF RUNONLY THEN STARTCOMPILE(COMPANDGO) ELSE STARTCOMPILE(COMPDEBUG) END { RUNWORKFILE } ; BEGIN (* BEGIN FCLOSE(USERINFO.SYMFIBP^,CNORMAL); FCLOSE(SWAPFIB^,CNORMAL); IF SYSCOM^.MISCINFO.HAS8510A THEN GETCMD*) FRESET(INPUTFIB^); FRESET(OUTPUTFIB^); FRESET(SYSTERM^); GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB; IF LASTST UNITCLEAR(3); WITH USERINFO DO IF ERRNUM > 0 THEN BEGIN GOTCODE := FALSE; FCLOSE(CODEFIBP^,CPURGE); IF ER = HALTINIT THEN $IF ASSOCIATE('*SYSTEM.STARTUP',FALSE,FALSE) THEN &BEGIN CLEARSCREEN; (WRITELN(OUTPUT,'Initializing...'); &  IF ASSOCIATE('*SYSTEM.LINKER', FALSE, FALSE) THEN BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END END; 'X': EXECUTE; 'C': STARTCOMPILE(COMPONLY); 'A': STARTCOMPILE(ASSEMONLY); ('U': IF LASTST <> UPROGNOU THEN BEGIN WRITELN(OUTPUT,'Restarting...'); GETCMD := SYSPROG; EXIT(GETCMD) END ELSE BEGIN WRITELN(OUTPUT); WRITE(OUTPUT,'U not allowed') END;  GETCMD := SYSPROG; EXIT(GETCMD) &END; "IF LASTST IN [COMPONLY,COMPANDGO,COMPDEBUG] THEN FINISHCOMPILE; IF LASTST IN [L 'R','D': RUNWORKFILE(TRUE, CH = 'R'); 'I','H': BEGIN GETCMD := HALTINIT; IF CH = 'H' THEN EMPTYHEAP := NIL; EINKANDGO,LINKDEBUG] THEN RUNWORKFILE(FALSE, LASTST = LINKANDGO); "IF SYSCOM^.MISCINFO.USERKIND = AQUIZ THEN XIT(GETCMD) END END UNTIL FALSE END (*GETCMD*) ; $IF LASTST = HALTINIT THEN $ BEGIN LASTST := COMPANDGO; RUNWORKFILE(TRUE, TRUE) END $ELSE &BEGIN (EMPTYHEAP := NIL; (GETCMD := HALTINIT; (EXIT(GETCMD) &END; WITH USERINFO DO BEGIN ERRNUM := 0; ERRBLK := 0; ERRSYM := 0 END; BADCMD := FALSE; REPEAT PL :=  'Command: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem, D(ebug,? [I.5]'; PROMPT; CH := GETCHAR(BADCMD); CLEARSCREEN; IF CH = '?' THEN &BEGIN PL := 'Command: U(ser restart, I(nitialize, H(alt'; (PROMPT; CH := GETCHAR(BADCMD); CLEARSCREEN &END; $BADCMD := NOT (CH IN ['E','R','F','C','L','X','A','D','U','I','H','?']); IF NOT BADCMD THEN  CASE CH OF 'E': BEGIN WRITELN(OUTPUT); IF ASSOCIATE('*SYSTEM.EDITOR', FALSE, FALSE) THEN BEGIN GETCMD := SYSPROG; EXIT(O^GETCMD) END END; 'F': BEGIN WRITELN(OUTPUT); IF ASSOCIATE('*SYSTEM.FILER', FALSE, FALSE) THEN BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END END; 'L': BEGIN WRITELN(OUTPUT,'Linking...');   GFILES[0] := INPUTFIB; GFILES[1] := OUTPUTFIB; BOMBIPC := IORESULT; FWRITELN(SYSTERM^); OM^,CRTCTRL DO BEGIN IF MISCINFO.HAS8510A THEN UNITCLEAR(3); IF ERASEEOS <> CHR(0) THEN BEGIN IF ESCAPE <> C IF UNITABLE[SYSUNIT].UVID = SYVID THEN PRINTERROR(XEQERR,BOMBIPC) ELSE BEGIN WRITE(OUTPUT,'Exec err # ',XHR(0) THEN WRITE(OUTPUT,ESCAPE); WRITE(OUTPUT,ERASEEOS); IF LENGTH(FILLER) > 0 THEN WRITE(OUTPUT,FILLER) END EQERR); IF XEQERR = 10 THEN WRITE(OUTPUT,',',BOMBIPC) END; WRITELN(OUTPUT); IF NOT SPACEWAIT(TRUE) THEN EXIT END END (*CLEARSCREEN*) ; PROCEDURE CLEARLINE; BEGIN WITH SYSCOM^,CRTCTRL DO IF ERASEEOL <> CHR(0) THEN BEGIN IF(COMMAND) END END END (*EXECERROR*) ; FUNCTION CHECKDEL(CH: CHAR; VAR SINX: INTEGER): BOOLEAN; BEGIN CHECKDEL := FALSE;  ESCAPE <> CHR(0) THEN WRITE(OUTPUT,ESCAPE); WRITE(OUTPUT,ERASEEOL); IF LENGTH(FILLER) > 0 THEN WRITE(OUTPUT,FILLER) WITH SYSCOM^,CRTCTRL,CRTINFO DO BEGIN IF CH = LINEDEL THEN BEGIN CHECKDEL := TRUE; IF (BACKSPACE = CHR(0)) OR (ERA END END (*CLEARLINE*) ; PROCEDURE PROMPT; VAR I: INTEGER; BEGIN HOMECURSOR; WITH SYSCOM^,CRTCTRL DO BEGIN CSEEOL = CHR(0)) THEN BEGIN SINX := 1; WRITELN(OUTPUT,' 1 DO LEARLINE; IF MISCINFO.SLOWTERM THEN BEGIN I := SCAN(LENGTH(PL),=':',PL[1]); IF I <> LENGTH(PL) THEN PL[0] := CHR(I+  (******************************************************************) $(* BEGIN SINX := SINX-1; WRITE(OUTPUT,BACKSPACE) END; WRITE(OUTPUT,ESCAPE,ERASEEOL) END END; IF CH = CHARDEL THE *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribuN BEGIN CHECKDEL := TRUE; IF SINX > 1 THEN BEGIN SINX := SINX-1; IF BACKSPACE = CHR(0) THEN IF CHARDEL < ' ' Tte this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from tHEN WRITE(OUTPUT,'_') ELSE (*ASSUME PRINTABLE*) ELSE BEGIN IF CHARDEL <> BACKSPACE THEN he Institute for Information Systems. *) $(* *) $(**** WRITE(OUTPUT,BACKSPACE); WRITE(OUTPUT,' ',BACKSPACE) END END ELSE IF CHARDEL = BACKSPACE THEN WR**************************************************************) $ PROCEDURE EXECERROR; BEGIN WITH SYSCOM^ DO BEGIN ITE(OUTPUT,' ') END END END (*CHECKDEL*) ; PROCEDURE HOMECURSOR; BEGIN WITH SYSCOM^,CRTCTRL DO BEGIN IF ESCAPEIF XEQERR = 4 THEN BEGIN RELEASE(EMPTYHEAP); PL := '*STK OFLOW*'; UNITWRITE(2,PL[1],LENGTH(PL)); EXIT(COMMAND) END;  <> CHR(0) THEN FWRITECHAR(SYSTERM^,ESCAPE,1); FWRITECHAR(SYSTERM^,HOME,1); IF (LENGTH(FILLER) > 0) AND (HOME <> CH BOMBP^.MSIPC := BOMBIPC; IF BUGSTATE <> 0 THEN BEGIN DEBUGGER; XEQERR := 0 END ELSE BEGIN RELEASE(EMPTYHEAP);R(EOL)) THEN FWRITESTRING(SYSTERM^,FILLER,0) END END (*HOMECURSOR*) ; PROCEDURE CLEARSCREEN; BEGIN HOMECURSOR; WITH SYSC ; READ(INPUT,CH); IF (CH >= 'a') AND (CH <= 'z') THEN CH := CHR(ORD(CH)-ORD('a')+ORD('A')); GETCHAR := CH END (*GETCHAE ELSE BEGIN OK := FALSE; RBRACK := POS(']',FTITLE); IF RBRACK = 2 THEN OK := TRUE ELSE IF RBRACK > 2R*) ; FUNCTION SPACEWAIT(*FLUSH: BOOLEAN*); VAR CH: CHAR; BEGIN REPEAT WRITE(OUTPUT,'Type ');  THEN BEGIN OK := TRUE; I := 2; REPEAT CH := FTITLE[I]; IF CH IN DIGITS THEN FSEGS := FSEGS*10+(ORD(CH)-O IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN WRITE(OUTPUT,' to continue'); CH := GETCHAR(FLUSH); IF NOT EOLN(INPUT) TRD('0')) ELSE OK := FALSE; I := I+1 UNTIL (I = RBRACK) OR NOT OK; IF (I = 3) AND (RBRACK = 3) THEN IF FTITLHEN WRITELN(OUTPUT); CLEARLINE UNTIL (CH = ' ') OR (CH = SYSCOM^.CRTINFO.ALTMODE); SPACEWAIT := CH <> ' ' END (*SPE[I-1] = '*' THEN BEGIN FSEGS := -1; OK := TRUE END END END; SCANTITLE := OK; IF OK AND (LENGTH(FACEWAIT*) ; FUNCTION SCANTITLE(*FTITLE: STRING; VAR FVID: VID; VAR FTID: TID; VAR FSEGS: INTEGER; VAR FKIND: FILEKIND*); TID) > 5) THEN BEGIN FTITLE := COPY(FTID,LENGTH(FTID)-4,5); IF FTITLE = '.TEXT' THEN FKIND := TEXTFILE ELSE  VAR I,RBRACK: INTEGER; CH: CHAR; OK: BOOLEAN; BEGIN FVID := ''; FTID := ''; FSEGS := 0; FKIND := UNTYPEDFILE; SCANTITLE  IF FTITLE = '.CODE' THEN FKIND := CODEFILE ELSE IF FTITLE = '.INFO' THEN FKIND := INFOFILE ELSE IF FTITLE = := FALSE; I := 1; WHILE I <= LENGTH(FTITLE) DO BEGIN CH := FTITLE[I]; IF CH <= ' ' THEN DELETE(FTITLE,I,1) ELS'.GRAF' THEN FKIND := GRAFFILE ELSE IF FTITLE = '.FOTO' THEN FKIND := FOTOFILE END END END END END (*SCANTITE BEGIN IF (CH >= 'a') AND (CH <= 'z') THEN FTITLE[I] := CHR(ORD(CH)-ORD('a')+ORD('A')); I := I+1 END END; IFLE*) ; (* VOLUME AND DIRECTORY HANDLERS *) FUNCTION FETCHDIR(FUNIT: UNITNUM): BOOLEAN; VAR LINX: DIRRANGE; OK: BOOLEAN; HNOW LENGTH(FTITLE) > 0 THEN BEGIN IF FTITLE[1] = '*' THEN BEGIN FVID := SYVID; DELETE(FTITLE,1,1) END; I := POS(':: INTEGER; BEGIN FETCHDIR := FALSE; WITH SYSCOM^,UNITABLE[FUNIT] DO BEGIN (*READ IN AND VALIDATE DIR*) IF GDIRP = NI1) END END; WRITE(OUTPUT,PL) END (*PROMPT*) ; PROCEDURE FGOTOXY(*X,Y: INTEGER*); BEGIN (*ASSUME DATA MEDIA*) WITH SYSC',FTITLE); IF I <= 1 THEN BEGIN IF LENGTH(FVID) = 0 THEN FVID := DKVID; IF I = 1 THEN DELETE(FTITLE,1,1) END OM^.CRTINFO DO BEGIN IF X < 0 THEN X := 0; IF X > WIDTH THEN X := WIDTH; IF Y < 0 THEN Y := 0; IF Y  ELSE IF I-1 <= VIDLENG THEN BEGIN FVID := COPY(FTITLE,1,I-1); DELETE(FTITLE,1,I) END; IF LENGTH(FVI> HEIGHT THEN Y := HEIGHT END; WRITE(OUTPUT,CHR(30),CHR(X+32),CHR(Y+32)) END (*GOTOXY*) ; FUNCTION GETCHAR(*FLUSH: BOOLEAD) > 0 THEN BEGIN I := POS('[',FTITLE); IF I > 0 THEN I := I-1 ELSE I := LENGTH(FTITLE); IF I <= TIDLENG THEN N*); VAR CH: CHAR; BEGIN IF FLUSH THEN UNITCLEAR(1); IF INPUTFIB^.FEOF THEN EXIT(COMMAND); INPUTFIB^.FSTATE := FNEEDCHARBEGIN IF I > 0 THEN BEGIN FTID := COPY(FTITLE,1,I); DELETE(FTITLE,1,I) END; IF LENGTH(FTITLE) = 0 THEN OK := TRU GDIRP^[0] DO BEGIN OK := FALSE; (*CHECK OUT DIR*) IF (DFIRSTBLK = 0) AND ( (MISCINFO.USERKIND=BOOKER) .OR ( (MISCINND SYSCOM^.MISCINFO.HASCLOCK; IF NOT OK THEN BEGIN (*NO CLOCK OR TOO OLD*) UNITREAD(FUNIT,LDE,SIZEOF(DIRENTFO.USERKIND IN [AQUIZ,PQUIZ]) AND (DFKIND=SECUREDIR) ) OR ( (MISCINFO.USERKIND=NORMAL) AND (DFKIND=UNTYPEDFILE) ) ) RY),DIRBLK); IF IORESULT = ORD(INOERROR) THEN OK := DVID = LDE.DVID; END; IF OK THEN BEGIN (*WE GUESS ALL THEN IF (LENGTH(DVID) > 0) AND (LENGTH(DVID) <= VIDLENG) AND (DNUMFILES >= 0) AND (DNUMFILES <= MAXDIR) THEN IS SAFE...WRITEIT*) DFIRSTBLK := 0; (*DIRTY FIX FOR YALOE BUGS*) UNITWRITE(FUNIT,FDIR^, (DNUMFILES+1)*SIZEOF(DI BEGIN OK := TRUE; (*SO FAR SO GOOD*) IF DVID <> UVID THEN BEGIN (*NEW VOLUME IN UNIT...CAREFUL*) LINX := 1; RENTRY),DIRBLK); OK := IORESULT = ORD(INOERROR); IF DLASTBLK = 10 THEN (*REDUNDANT AFTERTHOUGHT*) UNITWRITE(FUNI WHILE LINX <= DNUMFILES DO WITH GDIRP^[LINX] DO IF (LENGTH(DTID) <= 0) OR (LENGTH(DTID) > TIDLENG) OR T,FDIR^, (DNUMFILES+1)*SIZEOF(DIRENTRY),6); IF OK THEN TIME(HNOW,DLOADTIME) END END; IF NOT OK THEN BEG (DLASTBLK < DFIRSTBLK) OR (DLASTBYTE > FBLKSIZE) OR (DLASTBYTE <= 0) OR (DACCESS.YEAR >= 100) THENIN SYSCOM^.IORSLT := ILOSTUNIT; UVID := ''; UEOVBLK := MMAXINT END END END (*WRITEDIR*) ;  BEGIN OK := FALSE; DELENTRY(LINX,GDIRP) END ELSE LINX := LINX+1; IF NOT OK THEN BEGIN (*MUST HAVEFUNCTION VOLSEARCH(*VAR FVID: VID; LOOKHARD: BOOLEAN; VAR FDIR: DIRP*); VAR LUNIT: UNITNUM; OK,PHYSUNIT: BOOLEAN; HNOW,LNOW: I BEEN CHANGED...WRITEIT*) UNITWRITE(FUNIT,GDIRP^, (DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK); OK := IORSLT = INOERROR NTEGER; BEGIN VOLSEARCH := 0; FDIR := NIL; OK := FALSE; PHYSUNIT := FALSE; IF LENGTH(FVID) > 0 THEN BEGIN IF (FVID END END END; IF OK THEN BEGIN UVID := DVID; UEOVBLK := DEOVBLK; TIME(HNOW,DLOADTIME) END END;[1] = '#') AND (LENGTH(FVID) > 1) THEN BEGIN OK := TRUE; LUNIT := 0; HNOW := 2; REPEAT IF FVID[HNOW] IN DIGITS THEN  FETCHDIR := OK; IF NOT OK THEN BEGIN UVID := ''; UEOVBLK := MMAXINT; RELEASE(GDIRP); GDIRP := NIL END END  LUNIT := LUNIT*10+ORD(FVID[HNOW])-ORD('0') ELSE OK := FALSE; HNOW := HNOW+1 UNTIL (HNOW > LENGTH(FVID)) OR NEND (*FETCHDIR*) ; PROCEDURE WRITEDIR(*FUNIT: UNITNUM; FDIR: DIRP*); VAR HNOW,LNOW: INTEGER; OK: BOOLEAN; LDE: DIRENTRY; OT OK; PHYSUNIT := OK AND (LUNIT > 0) AND (LUNIT <= MAXUNIT) END; IF NOT PHYSUNIT THEN BEGIN OK := FALSE; LUNIT := MABEGIN WITH UNITABLE[FUNIT],FDIR^[0] DO BEGIN OK := (UVID = DVID) AND ((DFKIND = UNTYPEDFILE) OR (DFKIND = SECUREDIRXUNIT; REPEAT OK := FVID = UNITABLE[LUNIT].UVID; IF NOT OK THEN LUNIT := LUNIT-1 UNTIL OK OR (LUNIT = 0) END L THEN NEW(GDIRP); UNITREAD(FUNIT,GDIRP^,SIZEOF(DIRECTORY),DIRBLK); OK := IORSLT = INOERROR; IF OK THEN WITH )); IF OK THEN BEGIN TIME(HNOW,LNOW); OK := (LNOW-DLOADTIME <= AGELIMIT) AND ((LNOW-DLOADTIME) >= 0) A  *) ; PROCEDURE DELENTRY(*FINX: DIRRANGE; FDIR: DIRP*); VAR I: DIRRANGE; BEGIN WITH FDIR^[0] DO BEGIN FOR I := FINDINX := I; I := LASTI END; I := I+1 END; IF DINX = 0 THEN IF FDIR^[0].DEOVBLK-FDIR^[LASTI].DLASTBLK >= FSEGS THEN X TO DNUMFILES-1 DO FDIR^[I] := FDIR^[I+1]; FDIR^[DNUMFILES].DTID := ''; DNUMFILES := DNUMFILES-1 END END (*DELDINX := LASTI+1 END; IF LASTI = MAXDIR THEN DINX := 0; IF DINX > 0 THEN BEGIN WITH LDE DO BEGIN  END; IF OK THEN IF UNITABLE[LUNIT].UISBLKD THEN WITH SYSCOM^ DO BEGIN OK := FALSE; (*SEE IF GDIRP IS GOOD*) IENTRY*) ; PROCEDURE INSENTRY(*VAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP*); VAR I: DIRRANGE; BEGIN WITH FDIR^[0] DO F GDIRP <> NIL THEN IF FVID = GDIRP^[0].DVID THEN BEGIN TIME(HNOW,LNOW);  BEGIN FOR I := DNUMFILES DOWNTO FINX DO FDIR^[I+1] := FDIR^[I]; FDIR^[FINX] := FENTRY; DNUMFILES := DNUMFI OK := LNOW-GDIRP^[0].DLOADTIME <= AGELIMIT END; IF NOT OK THEN BEGIN OK := PHYSUNIT; IF FETCHDIR(LUNIT) LES+1 END END (*INSENTRY*) ; FUNCTION ENTERTEMP(VAR FTID: TID; FSEGS: INTEGER; FKIND: FILEKIND; FDIR: DIRP): DIRRANTHEN IF NOT PHYSUNIT THEN OK := FVID = GDIRP^[0].DVID END END; IF NOT OK AND LOOKHARD THEN BEGIN LUNIT := MAXUGE; VAR I,LASTI,DINX,SINX: DIRRANGE; RT11ISH: BOOLEAN; SSEGS: INTEGER; LDE: DIRENTRY; PROCEDURE FINDMAX(CURINX: DIRRANIT; (*CHECK EACH DISK UNIT*) REPEAT WITH UNITABLE[LUNIT] DO IF UISBLKD THEN IF FETCHDIR(LUNIT) THEN OK :=NGE; FIRSTOPEN,NEXTUSED: INTEGER); VAR FREEAREA: INTEGER; BEGIN FREEAREA := NEXTUSED-FIRSTOPEN;  FVID = UVID; IF NOT OK THEN LUNIT := LUNIT-1 UNTIL OK OR (LUNIT = 0) END; IF OK THEN WITH UNITABLE[LUNIT] DO  IF FREEAREA > FSEGS THEN BEGIN SINX := DINX; SSEGS := FSEGS; DINX := CURINX; FSEGS := FREEAREA END ELSE  BEGIN VOLSEARCH := LUNIT; IF LENGTH(UVID) > 0 THEN FVID := UVID; IF UISBLKD AND (SYSCOM^.GDIRP <> NIL) THEN BEGIN FDIR IF FREEAREA > SSEGS THEN BEGIN SSEGS := FREEAREA; SINX := CURINX END END (*FINDMAX*) ; BEGIN (*ENTERTEMP*) DINX := 0;  := SYSCOM^.GDIRP; TIME(HNOW,FDIR^[0].DLOADTIME) END END END (*VOLSEARCH*) ; FUNCTION DIRSEARCH(*VAR FTID: TID; FLASTI := FDIR^[0].DNUMFILES; SINX := 0; SSEGS := 0; IF FSEGS <= 0 THEN BEGIN RT11ISH := FSEGS < 0; FOR I := 1 TO LINDPERM: BOOLEAN; FDIR: DIRP*); VAR I: DIRRANGE; FOUND: BOOLEAN; BEGIN DIRSEARCH := 0; FOUND := FALSE; I := 1; WHILE (I <= FASTI DO FINDMAX(I,FDIR^[I-1].DLASTBLK,FDIR^[I].DFIRSTBLK); FINDMAX(LASTI+1,FDIR^[LASTI].DLASTBLK,FDIR^[0].DEOVBLK); DIR^[0].DNUMFILES) AND NOT FOUND DO BEGIN WITH FDIR^[I] DO IF DTID = FTID THEN  IF RT11ISH THEN IF FSEGS DIV 2 <= SSEGS THEN BEGIN FSEGS := SSEGS; DINX := SINX END ELSE FSEGS := (FSEGS+1) DIV 2 END  IF FINDPERM = (DACCESS.YEAR <> 100) THEN BEGIN DIRSEARCH := I; FOUND := TRUE END; I := I+1 END END (*DIRSEARCH ELSE BEGIN I := 1; WHILE I <= LASTI DO BEGIN IF FDIR^[I].DFIRSTBLK-FDIR^[I-1].DLASTBLK >= FSEGS THEN BEGIN ! PROCEDURE RESETER(VAR F:FIB); VAR BIGGER: BOOLEAN; BEGIN WITH F DO BEGIN FREPTCNT := 0; FEOLN := FALSE; FEOF := FALSE DO IF FISOPEN AND (SYSCOM^.GDIRP = NIL) THEN BEGIN MARK(OLDHEAP); NBYTES := ORD(SYSCOM^.LASTMP)-ORD(OLDHEAP); I; IF FISBLKD THEN BEGIN BIGGER := FNXTBLK > FMAXBLK; IF BIGGER THEN FMAXBLK := FNXTBLK; IF FSOFTBUF THEN BEF (NBYTES > 0) AND (NBYTES < SIZEOF(DIRECTORY)+400) THEN BEGIN NBYTES := ORD(OLDHEAP)-ORD(EMPTYHEAP); IF (NBYTESGIN IF BIGGER THEN FMAXBYTE := FNXTBYTE ELSE IF FNXTBLK = FMAXBLK THEN IF FNXTBYTE > FMAXBYTE THEN BEGIN BIGGER > 0) AND (NBYTES > SIZEOF(DIRECTORY)) AND (UNITABLE[FUNIT].UVID = FVID) THEN BEGIN  := TRUE; FMAXBYTE := FNXTBYTE END; IF FBUFCHNGD THEN BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE; IF BIGGER THEN  UNITWRITE(FUNIT,EMPTYHEAP^,SIZEOF(DIRECTORY), FHEADER.DFIRSTBLK); RELEASE(EMPTYHEAP); SWAPPED := TRUE END  FILLCHAR(FBUFFER[FNXTBYTE],FBLKSIZE-FNXTBYTE,0); UNITWRITE(FUNIT,FBUFFER,FBLKSIZE, FHEADER.DFIRSTBLK+FNXTBLK END END; LUNIT := VOLSEARCH(LVID,TRUE,LDIR); IF LUNIT = 0 THEN SYSCOM^.IORSLT := INOUNIT ELSE WITH UNITABL DFIRSTBLK := FDIR^[DINX-1].DLASTBLK; DLASTBLK := DFIRSTBLK+FSEGS; DFKIND := FKIND; DTID := FTID; DLASTBYTE := FBLKSI-1); IF BIGGER AND (FHEADER.DFKIND = TEXTFILE) AND ODD(FNXTBLK) THEN BEGIN FMAXBLK := FMAXBLK+1; FILLCHAR(FZE; WITH DACCESS DO BEGIN MONTH := 0; DAY := 0; YEAR := 100 END END; INSENTRY(LDE,DINX,FDIR) END; ENTERTEMPBUFFER,FBLKSIZE,0); UNITWRITE(FUNIT,FBUFFER,FBLKSIZE, FHEADER.DFIRSTBLK+FNXTBLK) END END; FNXTBYTE := FBLK := DINX END (*ENTERTEMP*) ; (* FILE STATE HANDLERS *) PROCEDURE FINIT(*VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER*); BEGISIZE END; FNXTBLK := 0; IF FSOFTBUF AND (FHEADER.DFKIND = TEXTFILE) THEN FNXTBLK := 2 END END N WITH F DO BEGIN FSTATE := FJANDW; FISOPEN := FALSE; FEOF := TRUE; FEOLN := TRUE; FWINDOW := WINDOW; IFEND (*RESETER*) ; PROCEDURE FOPEN(*VAR F: FIB; VAR FTITLE: STRING; FOPENOLD: BOOLEAN; JUNK PARAM*); LABEL 1; VAR LDIR: D (RECWORDS = 0) OR (RECWORDS = -2) THEN BEGIN FWINDOW^[1] := CHR(0); FRECSIZE := 1; IF RECWORDS = 0 THEN FSTATE := FNEEDCIRP; LUNIT: UNITNUM; LINX: DIRRANGE; LSEGS,NBYTES: INTEGER; LKIND: FILEKIND; OLDHEAP: ^INTEGER; SWAPPED: BOOLEAN; HAR END ELSE IF RECWORDS < 0 THEN BEGIN FWINDOW := NIL; FRECSIZE := 0 END ELSE FRECSIZE := RECWORDS+RECWORDS END SAVERSLT: IORSLTWD; LVID: VID; LTID: TID; BEGIN SYSCOM^.IORSLT := INOERROR; WITH F DO IF FISOPEN THEN SYSCOM^.IORSLT : END (*FINIT*) ; = INOTCLOSED ELSE IF SCANTITLE(FTITLE,LVID,LTID,LSEGS,LKIND) THEN BEGIN (*GOT AN OK TITLE*) IF ORD(FOPENOLD) > 1 THEN (*OLD CODE SPECIAL CASE*) FOPENOLD := (ORD(FOPENOLD) = 2) OR (ORD(FOPENOLD) = 4); SWAPPED := FALSE; WITH SWAPFIB^" FILE THEN LKIND := DATAFILE; LINX := ENTERTEMP(LTID,LSEGS,LKIND,LDIR); IF (LINX > 0) AND (LKIND = TEXTFILE) THEN EGIN RELEASE(OLDHEAP); SYSCOM^.GDIRP := NIL; SAVERSLT := SYSCOM^.IORSLT; UNITREAD(SWAPFIB^.FUNIT,EMPTYHEAP^,SIZEOF WITH LDIR^[LINX] DO BEGIN IF ODD(DLASTBLK-DFIRSTBLK) THEN DLASTBLK := DLASTBLK-1; IF DLASTBLK-DFIR(DIRECTORY), SWAPFIB^.FHEADER.DFIRSTBLK); SYSCOM^.IORSLT := SAVERSLT END END ELSE SYSCOM^.IORSLT := IBADTSTBLK < 4 THEN BEGIN DELENTRY(LINX,LDIR); LINX := 0 END END; IF LINX = 0 THEN BEGIN SYSCOM^.IORSLT :=ITLE END (*FOPEN*) ; PROCEDURE FCLOSE(*VAR F: FIB; FTYPE: CLOSETYPE*); LABEL 1; VAR LINX,DUPINX: DIRRANGE; LDIR: DIRP; FOUN INOROOM; GOTO 1 END; FHEADER := LDIR^[LINX]; FMODIFIED := TRUE; WRITEDIR(LUNIT,LDIR) END END ELSE (*FHEADER D: BOOLEAN; BEGIN SYSCOM^.IORSLT := INOERROR; WITH F DO IF FISOPEN AND (FWINDOW <> SYSTERM^.FWINDOW) THEN BEGIN NOT IN DIRECTORY*) WITH FHEADER DO BEGIN (*DIRECT UNIT OPEN, SET UP DUMMY FHEADER*) DFIRSTBLK := 0; DLASTBLK : IF FISBLKD THEN WITH FHEADER DO IF LENGTH(DTID) > 0 THEN BEGIN (*FILE IN A DISK DIRECTORY...FIXUP MAYBE*) IF F= MMAXINT; IF UISBLKD THEN DLASTBLK := UEOVBLK; DFKIND := LKIND; DTID := ''; DLASTBYTE := FBLKSIZE; TYPE = CCRUNCH THEN BEGIN FMAXBLK := FNXTBLK; DACCESS.YEAR := 100; FTYPE := CLOCK; IF FSOFTBUF THEN FMAXBYTE :=  WITH DACCESS DO BEGIN MONTH := 0; DAY := 0; YEAR := 0 END END; IF FOPENOLD THEN FMAXBLK := FHEADER.DLASTBLK-FFNXTBYTE END; RESETER(F); IF FMODIFIED OR (DACCESS.YEAR = 100) OR (FTYPE = CPURGE) THEN BEGIN (*HAVE TO CHANGE DIRECHEADER.DFIRSTBLK ELSE FMAXBLK := 0; IF FSOFTBUF THEN BEGIN FNXTBYTE := FBLKSIZE; FBUFCHNGD := FALSE; IF FOPETORY ENTRY*) IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END; LINXE[LUNIT] DO BEGIN (*OK...OPEN UP FILE*) FISOPEN := TRUE; FMODIFIED := FALSE; FUNIT := LUNIT; FVID := LVID; FNXTBLK NOLD THEN FMAXBYTE := FHEADER.DLASTBYTE ELSE FMAXBYTE := FBLKSIZE; WITH FHEADER DO := 0; FISBLKD := UISBLKD; FSOFTBUF := UISBLKD AND (FRECSIZE <> 0); IF (LDIR <> NIL) AND (LENGTH(LTID) > 0) THEN BEGIN (* IF DFKIND = TEXTFILE THEN BEGIN FNXTBLK := 2; IF NOT FOPENOLD THEN BEGIN (*NEW .TEXT, PUT NULLS IN FIRST LOOKUP OR ENTER FHEADER IN DIRECTORY*) LINX := DIRSEARCH(LTID,FOPENOLD,LDIR); IF FOPENOLD THEN IF LINX = 0 TPAGE*) FILLCHAR(FBUFFER,SIZEOF(FBUFFER),0); UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK); UNITWRITE(FUHEN BEGIN SYSCOM^.IORSLT := INOFILE; GOTO 1 END ELSE FHEADER := LDIR^[LINX] ELSE (*OPEN NEW FILE*) IF LNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+1) END END END; IF FOPENOLD THEN FRESET(F) ELSE RESETER(F); (*NO GET!*) 1: IF INX > 0 THEN BEGIN SYSCOM^.IORSLT := IDUPFILE; GOTO 1 END ELSE BEGIN (*MAKE A TEMP ENTRY*) IF LKIND = UNTYPEDIORESULT <> ORD(INOERROR) THEN BEGIN FISOPEN := FALSE; FEOF := TRUE; FEOLN := TRUE END END; IF SWAPPED THEN B#  IF NOT FOUND THEN BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END; LINX := LINX - 1; (*CORRECT OVERRUN*) IF ((FTYPE = CNORMAL) AND (LDIR^[LINX].DACCESS.YEAR = 100)) OR (FTYPE = CPURGE) THEN  DELENTRY(LINX,LDIR) (*ZAP FILE OUT OF EXISTANCE*) ELSE BEGIN (*WELL...LOCK IN A PERM DIR ENTRY*) DUPINX := DIRSEARCH(DTID,TRUE,LDIR); IF (DUPINX <> 0) AND (DUPINX <> LINX) THEN BEGIN (*A DUPLICATE PERM ENTRY...ZAP OLD ONE*)  DELENTRY(DUPINX,LDIR); IF DUPINX < LINX THEN LINX := LINX-1 END; IF LDIR^[LINX].DACCESS.YEAR = 100 THEN IF DACCESS.YEAR = 100 THEN DACCESS := THEDATE ELSE (*LEAVE ALONE...FILER SPECIAL CASE*) ELSE IF FMODIFIED AN {$I GLOBALS } {$I SYSSEGS }  {$I SYSTEM.B } {$I SYSTEM.C } D (THEDATE.MONTH <> 0) THEN DACCESS := THEDATE ELSE DACCESS := LDIR^[LINX].DACCESS; DLASTBLK := DFIRSTBLK+FMAXBLK; IF FSOFTBUF THEN DLASTBYTE := FMAXBYTE; FMODIFIED := FALSE; LDIR^[LINX] := FHEADER END; WRITEDIR(FUNIT,LDIR) END END; IF FTYPE = CPURGE THEN IF LENGTH(FHEADER.DTID) = 0 THEN UNITABLE[FUNIT].UVID := ''; 1: FEOF := TRUE; FEOLN := TRUE; FISOPEN := FALSE END END (*FCLOSE*) ; O^ := 1; FOUND := FALSE; WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO BEGIN (*LOOK FOR FIRST BLOCK MATCH*)  FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND (LDIR^[LINX].DLASTBLK = DLASTBLK); LINX := LINX + 1 END; $ te this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from t END; FEOF := FALSE; FEOLN := FALSE; ,IF FSTATE <> FJANDW THEN FSTATE := FNEEDCHAR; (*RJH 2Mar78*) he Institute for Information Systems. *) $(* *) $(******************************************************************) $ (* INPUT-OUTPUT PRIMITIVES *) PROCEDURE XSEEK; BEGIN SYSCOO^M^.XEQERR := 11; { NOT IMP ERR } EXECERROR END (*XSEEK*) ; PROCEDURE XREADREAL; BEGIN SYSCOM^.XEQERR := 11; { NOT IMP ERR }JJ EXECERROR END (*XREADREAL*) ; PROCEDURE XWRITEREAL; BEGIN SYSCOM^.XEQERR := 11; { NOT IMP ERR } EXECERROR END (*XWRITEREAL*) ; FUNCTION CANTSTRETCH(VAR F: FIB): BOOLEAN; (*REPLACED BY RJH 2Mar78*) LABEL 1;  VAR LINX: DIRRANGE; FOUND: BOOLEAN; LAVAILBLK: INTEGER; LDIR: DIRP; BEGIN CANTSTRETCH := TRUE; "WITH F,FHEADER DO IF LENGTH(DTID) > 0 THEN BEGIN (*IN A DIRECTORY FOR SURE*) IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END; FOUND := FALSE; LINX := 1; WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO BEGIN FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND (LDIR^[LINX].DLASTBLK = DLASTBLK); LINX := LINX+1 END; IF NOT FOUND THEN BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END; (IF LINX > LDIR^[0].DNUMFILES THEN LAVAILBLK := LDIR^[0].DEOVBLK ELSE L  (******************************************************************) $(* AVAILBLK := LDIR^[LINX].DFIRSTBLK; IF (DLASTBLK < LAVAILBLK) OR (DLASTBYTE < FBLKSIZE) THEN BEGIN WITH LDIR^[LINX-1] DO *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribu BEGIN DLASTBLK := LAVAILBLK; DLASTBYTE := FBLKSIZE; 0WRITEDIR(FUNIT,LDIR); IF IORESULT <> ORD(INOERROR) THEN GOTO 1% K) END; FBLOCKIO := NBLOCKS; RBLOCK := RBLOCK+NBLOCKS; FEOF := RBLOCK = DLASTBLK; FNXTBLK := RBLOCK-DFIRSTBLK; IF WRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK-1) END; IF IORESULT <> ORD(INOERROR) THEN GOTO 1; UNITREAD(FUFNXTBLK > FMAXBLK THEN FMAXBLK := FNXTBLK END END ELSE BEGIN FBLOCKIO := NBLOCKS; IF DOREAD THEN UNITRENIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK); IF IORESULT <> ORD(INOERROR) THEN GOTO 1; AD(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK) ELSE UNITWRITE(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK); IF IORESULT = ORD(INOERROR) THEN FNXTBLK := FNXTBLK+1; FNXTBYTE := 0 END UNTIL DONE END ELSE BEGIN UNITREAD(FUNIT,FWINDOW^,FRECSIZ IF DOREAD THEN BEGIN RBLOCK := NBLOCKS*FBLKSIZE; RBLOCK := RBLOCK+SCAN(-RBLOCK,<>CHR(0),A[RBLOCK-1]); RBLOCK :=E); IF IORESULT <> ORD(INOERROR) THEN GOTO 1 END; IF FRECSIZE = 1 THEN (*FILE OF CHAR*) BEGIN FEOLN := FALSE; I,DLASTBLK := LAVAILBLK; DLASTBYTE := FBLKSIZE; DACCESS.YEAR := 100; CANTSTRETCH := FALSE END END; "IF FALSE THEN (RBLOCK+FBLKSIZE-1) DIV FBLKSIZE; FBLOCKIO := RBLOCK; FEOF := RBLOCK < NBLOCKS END ELSE ELSE FBLOCKIO := 0  1: BEGIN F.FEOF := TRUE; F.FEOLN := TRUE END END (*CANTSTRETCH*) ; PROCEDURE FRESET(*VAR F: FIB*); BEGIN SYSCOM^.IORSLT := INEND ELSE SYSCOM^.IORSLT := INOTOPEN END (*FBLOCKIO*) ; PROCEDURE FGET(*VAR F: FIB*); LABEL 1, 2; VAR LEFTOGET,WINOERROR; WITH F DO IF FISOPEN THEN BEGIN RESETER(F); IF FRECSIZE > 0 THEN IF FSTATE = FJANDW THEN FGET(F) ELSEINX,LEFTINBUF,AMOUNT: INTEGER; DONE: BOOLEAN; BEGIN SYSCOM^.IORSLT := INOERROR; WITH F DO IF FISOPEN THEN  FSTATE := FNEEDCHAR END END (*FRESET*) ; FUNCTION FBLOCKIO(*VAR F: FIB; VAR A: WINDOW; NBLOCKS,RBLOCK: INTEGER; DOR BEGIN IF FREPTCNT > 0 THEN BEGIN FREPTCNT := FREPTCNT-1; IF FREPTCNT > 0 THEN GOTO 2 END; IF FSOFTBUF THEN WITH FHEAD: BOOLEAN*); BEGIN FBLOCKIO := 0; SYSCOM^.IORSLT := INOERROR; WITH F DO IF FISOPEN AND (NBLOCKS >= 0) THEN IF FISEADER DO BEGIN LEFTOGET := FRECSIZE; WININX := 0; REPEAT IF FNXTBLK = FMAXBLK THEN IF FNXTBYTE+LEFTOGETBLKD THEN WITH FHEADER DO BEGIN IF RBLOCK < 0 THEN RBLOCK := FNXTBLK; RBLOCK := DFIRSTBLK+RBLOCK; IF RBLOCK+N > FMAXBYTE THEN GOTO 1 ELSE LEFTINBUF := DLASTBYTE-FNXTBYTE ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE; AMOUNT := LEFTOGET; BLOCKS > DLASTBLK THEN IF NOT DOREAD THEN IF CANTSTRETCH( F ) THEN; IF RBLOCK+NBLOCKS > DLASTBLK THEN NBLOCIF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF; IF AMOUNT > 0 THEN BEGIN MOVELEFT(FBUFFER[FNXTBYTE],FWINDOW^[WININX]KS := DLASTBLK-RBLOCK; FEOF := RBLOCK >= DLASTBLK; IF NOT FEOF THEN BEGIN IF DOREAD THEN ,AMOUNT); FNXTBYTE := FNXTBYTE+AMOUNT; WININX := WININX+AMOUNT; LEFTOGET := LEFTOGET-AMOUNT END; DONE := UNITREAD(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOCK) ELSE BEGIN FMODIFIED := TRUE; UNITWRITE(FUNIT,A,NBLOCKS*FBLKSIZE,RBLOC LEFTOGET = 0; IF NOT DONE THEN BEGIN IF FBUFCHNGD THEN BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE; UNIT& 1: FEOF := TRUE; FEOLN := TRUE END; 2: END (*FGET*) ; PROCEDURE FPUT(*VAR F: FIB*); LABEL 1; VAR LEFTOPUT,WININX,LEFT] := CHR(0); FPUT(F) END END ELSE BEGIN UNITWRITE(FUNIT,FWINDOW^,FRECSIZE); IF IORESULT <> ORD(INOINBUF,AMOUNT: INTEGER; DONE: BOOLEAN; BEGIN SYSCOM^.IORSLT := INOERROR; WITH F DO IF FISOPEN THEN BEGIN IF FSERROR) THEN GOTO 1 END END ELSE BEGIN SYSCOM^.IORSLT := INOTOPEN; 1: FEOF := TRUE; FEOLN := TRUE END EOFTBUF THEN WITH FHEADER DO BEGIN LEFTOPUT := FRECSIZE; WININX := 0; REPEAT IF DFIRSTBLK+FNXTBLK = DLASTND (*FPUT*) ; FUNCTION FEOF(*VAR F: FIB*); BEGIN FEOF := F.FEOF END; (* TEXT FILE INTRINSICS *) BLK THEN IF FNXTBYTE+LEFTOPUT > DLASTBYTE THEN IF CANTSTRETCH( F ) THEN BEGIN SYSCOM^.IORSLT := INOROOM; GOTO 1 ENFUNCTION FEOLN(*VAR F: FIB*); BEGIN FEOLN := F.FEOLN END; PROCEDURE FWRITELN(*VAR F: FIB*); BEGIN F.FWINDOW^[0] := CHR(EOL); D ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE ELSE LEFTINBUF := DLASTBYTE-FNXTBYTE ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE; AMFPUT(F) END (*FWRITELN*) ; PROCEDURE FWRITECHAR(*VAR F: FIB; CH: CHAR; RLENG: INTEGER*); LABEL 1; BEGIN WITH F DO IF FOUNT := LEFTOPUT; IF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF; IF AMOUNT > 0 THEN BEGIN FBUFCHNGD := TRUE; MOVEISOPEN THEN IF FSOFTBUF THEN BEGIN WHILE RLENG > 1 DO BEGIN FWINDOW^[0] := ' '; FPUT(F); RLENG := RLENG-1 LEFT(FWINDOW^[WININX],FBUFFER[FNXTBYTE],AMOUNT); FNXTBYTE := FNXTBYTE+AMOUNT; WININX := WININX+AMOUNT; LEFTOPU END; FWINDOW^[0] := CH; FPUT(F) END ELSE BEGIN WHILE RLENG > 1 DO BEGIN FWINDOW^[0] := ' '; UNITWF FSTATE <> FJANDW THEN FSTATE := FGOTCHAR; IF FWINDOW^[0] = CHR(EOL) THEN BEGIN FWINDOW^[0] := ' '; FEOLN := TRUE; T := LEFTOPUT-AMOUNT END; DONE := LEFTOPUT = 0; IF NOT DONE THEN BEGIN IF FBUFCHNGD THEN GOTO 2 END; IF FWINDOW^[0] = CHR(DLE) THEN BEGIN FGET(F); AMOUNT := ORD(FWINDOW^[0])-32; IF (AMOUNT > 0) AND (AM BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE; UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNXTBLK-1) END; OUNT <= 127) THEN BEGIN FWINDOW^[0] := ' '; FREPTCNT := AMOUNT; GOTO 2 END; FGET(F) END;  IF IORESULT <> ORD(INOERROR) THEN GOTO 1; IF FNXTBLK < FMAXBLK THEN UNITREAD(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+FNX IF FWINDOW^[0] = CHR(0) THEN BEGIN (*EOF HANDLING*) IF FSOFTBUF AND (FHEADER.DFKIND = TEXTFILE) THEN BEGIN (*END OTBLK) ELSE FILLCHAR(FBUFFER,FBLKSIZE,CHR(0)); IF IORESULT <> ORD(INOERROR) THEN GOTO 1; FNXTBLK := FNXF 2 BLOCK PAGE*) IF ODD(FNXTBLK) THEN FNXTBLK := FNXTBLK+1; FNXTBYTE := FBLKSIZE; FGET(F) END ELSE BEGIN FTBLK+1; FNXTBYTE := 0 END UNTIL DONE; IF FRECSIZE = 1 THEN IF FWINDOW^[0] = CHR(EOL) THEN IF DFKIND = TEWINDOW^[0] := ' '; GOTO 1 END END END END ELSE BEGIN SYSCOM^.IORSLT := INOTOPEN; XTFILE THEN IF (FNXTBYTE >= FBLKSIZE-127) AND NOT ODD(FNXTBLK) THEN BEGIN FNXTBYTE := FBLKSIZE-1; FWINDOW^[0' 0 THEN BEGIN I := ABS(I); S[1] := '-'; COL := 2; IF I = 0 THEN (*HARDWARE SPECIAL CASE*) HILE NOT FEOLN DO FGET(F) END END (*FREADSTRING*) ; PROCEDURE FWRITEBYTES(*VAR F: FIB; VAR A: WINDOW; RLENG,ALENG: INTEGE BEGIN S := '-32768'; GOTO 1 END END; FOR POT := 4 DOWNTO 0 DO BEGIN CH := CHR(I DIV IPOT[POT] + ORD('0')); IF (R*); VAR AINX: INTEGER; BEGIN WITH F DO IF FISOPEN THEN BEGIN IF RLENG > ALENG THEN BEGIN FWRITECHAR(F,' ',RLECH = '0') AND (POT > 0) AND SUPPRESSING THEN ELSE (*FORMAT THE CHAR*) BEGIN SUPPRESSING := FALSE; S[COL] := CH; COL :=NG-ALENG); RLENG := ALENG END; IF FSOFTBUF THEN BEGIN AINX := 0; WHILE (AINX < RLENG) AND NOT FEOF DO BEGIN FWIN COL+1; IF CH <> '0' THEN I := I MOD IPOT[POT] END END; S[0] := CHR(COL-1); 1:IF RLENG < LENGTH(S) THEN RLENG := LDOW^[0] := A[AINX]; FPUT(F); AINX := AINX+1 END END ELSE UNITWRITE(FUNIT,A,RLENG) END ENGTH(S); FWRITESTRING(F,S,RLENG) END (*FWRITEINT*) ; PROCEDURE FWRITESTRING(*VAR F: FIB; VAR S: STRING; RLENG: INTEGER*);  ELSE SYSCOM^.IORSLT := INOTOPEN END (*FWRITEBYTES*) ; PROCEDURE FREADLN(*VAR F: FIB*); BEGIN WHILE NOT F.FEOLN DO FGET(F)VAR SINX: INTEGER; BEGIN WITH F DO IF FISOPEN THEN BEGIN IF RLENG <= 0 THEN RLENG := LENGTH(S); IF RLENG > LENGTH(; IF F.FSTATE = FJANDW THEN FGET(F) ELSE BEGIN F.FSTATE := FNEEDCHAR; F.FEOLN := FALSE END END (*FREADLN*) ; PROCEDURE S) THEN BEGIN FWRITECHAR(F,' ',RLENG-LENGTH(S)); RLENG := LENGTH(S) END; IF FSOFTBUF THEN BEGIN SINX := 1; WHILE (SIFREADCHAR(*VAR F: FIB; VAR CH: CHAR*); BEGIN WITH F DO BEGIN SYSCOM^.IORSLT := INOERROR; IF FSTATE = FNEEDCHAR THEN FGENX <= RLENG) AND NOT FEOF DO BEGIN FWINDOW^[0] := S[SINX]; FPUT(F); SINX := SINX+1 END END ELSE UNITWRITE(FUNIT,S[T(F); CH := FWINDOW^[0]; IF FSTATE = FJANDW THEN FGET(F) ELSE FSTATE := FNEEDCHAR END END (*FREADCHAR*) ; PROCEDURE FR1],RLENG) END ELSE SYSCOM^.IORSLT := INOTOPEN END (*FWRITESTRING*) ; EADINT(*VAR F: FIB; VAR I: INTEGER*); LABEL 1; VAR CH: CHAR; NEG,IVALID: BOOLEAN; SINX: INTEGER; BEGIN WITH F DO BEGPROCEDURE FREADSTRING(*VAR F: FIB; VAR S: STRING; SLENG: INTEGER*); VAR SINX: INTEGER; CH: CHAR; BEGIN WITH F DO BEGININ I := 0; NEG := FALSE; IVALID := FALSE; IF FSTATE = FNEEDCHAR THEN FGET(F); WHILE (FWINDOW^[0] = ' ') AND NOT FEOF DO FGET(FRITE(FUNIT,FWINDOW^,1); RLENG := RLENG-1 END; FWINDOW^[0] := CH; UNITWRITE(FUNIT,FWINDOW^,1) END ELSE SYS SINX := 1; IF FSTATE = FNEEDCHAR THEN FGET(F); S[0] := CHR(SLENG); (*NO INV INDEX*) WHILE (SINX <= SLENG) AND NOT (FEOLN OR COM^.IORSLT := INOTOPEN; 1: END (*FWRITECHAR*) ; PROCEDURE FWRITEINT(*VAR F: FIB; I,RLENG: INTEGER*); LABEL 1; VAR POT,COL:FEOF) DO BEGIN CH := FWINDOW^[0]; IF FUNIT = 1 THEN IF CHECKDEL(CH,SINX) THEN ELSE BEGIN S[SINX] := CH;  INTEGER; CH: CHAR; SUPPRESSING: BOOLEAN; S: STRING[10]; BEGIN COL := 1; S[0] := CHR(10); SUPPRESSING := TRUE; IF I < SINX := SINX + 1 END ELSE BEGIN S[SINX] := CH; SINX := SINX + 1 END; FGET(F) END; S[0] := CHR(SINX - 1); W( ); IF FEOF THEN GOTO 1; CH := FWINDOW^[0]; IF (CH = '+') OR (CH = '-') THEN BEGIN NEG := CH = '-'; FGET(F); CH := FWINDOW^ DEST[0] := CHR(COPYLENG) END END (*SCOPY*) ; PROCEDURE SDELETE(*VAR DEST: STRING; DELINX,DELLENG: INTEGER*); VAR ONR[0] END; IF CH IN DIGITS THEN *BEGIN IVALID := TRUE; SINX := 1; ,REPEAT .I := I*10+ORD(CH)-ORD('0'); IGHT: INTEGER; BEGIN IF (DELINX > 0) AND (DELLENG > 0) THEN BEGIN ONRIGHT := LENGTH(DEST)-DELINX-DELLENG+1; IF.FGET(F); CH := FWINDOW^[0]; SINX := SINX+1; .IF FUNIT = 1 THEN 0WHILE CHECKDEL(CH,SINX) DO 2BEGIN 4IF SINX = 1 THEN I := 0 ONRIGHT = 0 THEN DEST[0] := CHR(DELINX-1) ELSE IF ONRIGHT > 0 THEN BEGIN MOVELEFT(DEST[DELINX+DELLENG],DEST[DELI ELSE I := I DIV 10; 4FGET(F); CH := FWINDOW^[0] 2END ,UNTIL NOT (CH IN DIGITS) OR FEOLN *END; IF IVALID OR FEOF THEN IFNX],ONRIGHT); DEST[0] := CHR(LENGTH(DEST)-DELLENG) END END END (*SDELETE*) ;  FUNCTION SPOS(*VAR TARGET, SRC: STRI NEG THEN I := -I ELSE (*NADA*) ELSE SYSCOM^.IORSLT := IBADFORMAT END; 1: END (*FREADINT*) ; (* STRING VARIABLE INTRINSING*);  LABEL 1;  VAR TEMPLOC,DIST: INTEGER;  FIRSTCH: CHAR; %TEMP: STRING;  BEGIN SPOS := 0; CS *) PROCEDURE SCONCAT(*VAR SRC,DEST: STRING; DESTLENG: INTEGER*); BEGIN IF LENGTH(SRC)+LENGTH(DEST) <= DESTLENG THEN BE"IF LENGTH(TARGET) > 0 THEN $BEGIN &FIRSTCH := TARGET[1]; &TEMPLOC := 1; &DIST := LENGTH(SRC)-LENGTH(TARGET) + 1; &TEMP[0]GIN MOVELEFT(SRC[1],DEST[LENGTH(DEST)+1],LENGTH(SRC)); DEST[0] := CHR(LENGTH(SRC)+LENGTH(DEST)) END END (*SCONCA := TARGET[0]; &WHILE TEMPLOC <= DIST DO (BEGIN *TEMPLOC := TEMPLOC + SCAN(DIST-TEMPLOC,=FIRSTCH,SRC[TEMPLOC]) ; *IF TEMPLOT*) ; PROCEDURE SINSERT(*VAR SRC,DEST: STRING; DESTLENG,INSINX: INTEGER*); VAR ONRIGHT: INTEGER; BEGIN IF (INSINX > 0) AND C>DIST THEN -GOTO 1; *MOVELEFT(SRC[TEMPLOC],TEMP[1],LENGTH(TARGET)); *IF TEMP=TARGET THEN ,BEGIN SPOS := TEMPLOC; GOTO 1 END(LENGTH(SRC) > 0) AND (LENGTH(SRC)+LENGTH(DEST) <= DESTLENG) THEN BEGIN ONRIGHT := LENGTH(DEST)-INSINX+1; ; *TEMPLOC := TEMPLOC+1 (END $END;  1:  END (*SPOS*) ;  (* MAIN DRIVER OF SYSTEM *) PROCEDURE COMMAND; VAR T: INTEGER;IF ONRIGHT > 0 THEN BEGIN MOVERIGHT(DEST[INSINX],DEST[INSINX+LENGTH(SRC)],ONRIGHT); ONRIGHT := 0 END;  BEGIN STATE := HALTINIT; REPEAT RELEASE(EMPTYHEAP); WHILE UNITABLE[SYSCOM^.SYSUNIT].UVID <> SYVID DO BEGIN PL  IF ONRIGHT = 0 THEN BEGIN MOVELEFT(SRC[1],DEST[INSINX],LENGTH(SRC)); DEST[0] := CHR(LENGTH(DEST)+LENGTH(SRC)) END := 'Put in :'; INSERT(SYVID,PL,8); PROMPT; T := 4000; REPEAT T := T-1 UNTIL T = 0; IF FETCHDIR(SYSCOM^.SYSUNIT) THEN  END END (*SINSERT*) ; PROCEDURE SCOPY(*VAR SRC,DEST: STRING; SRCINX,COPYLENG: INTEGER*); BEGIN DEST := ''; IF (SRCINX > 0END; STATE := GETCMD(STATE); CASE STATE OF UPROGNOU,UPROGUOK,SYSPROG, COMPONLY,COMPANDGO,COMPDEBUG, LI) AND (COPYLENG > 0) AND (SRCINX+COPYLENG-1 <= LENGTH(SRC)) THEN BEGIN MOVELEFT(SRC[SRCINX],DEST[1],COPYLENG); NKANDGO,LINKDEBUG: USERPROGRAM(NIL,NIL); &DEBUGCALL: DEBUGGER END; IF STATE IN [UPROGNOU,UPROGUOK] THEN ) 8 *) (* I.5 SEPTEMBER, 1978 *)  (* *) (* WRITTEN BY ROGER T. SUMNER *) (* WINTER 1977 *) (*  *) (* INSTITUTE FOR INFORMATION SYSTEMS *) (* UC SAN DIEGO, LA JOLLA, CA *) ( BEGIN FCLOSE(GFILES[0]^,CNORMAL); FCLOSE(GFILES[1]^,CLOCK) END; IF UNITBUSY(1) OR UNITBUSY(2) THEN UNITCLEAR(1) UNTIL STATE = HALTINIT END (*COMMAND*) ; BEGIN (*UCSD PASCAL SYSTEM*) EMPTYHEAP := NIL; INITIALIZE; REPEAT COMMAND; IF EMPTYHEAP <> NIL THEN INITIALIZE UNTIL EMPTYHEAP = NIL END (*PASCALSYSTEM*) . (*$U-,S+*)   (******************************************************************) $(*  *) $(* Copyright (c) 1978 Regents of the University of California. *) $(* Permission to copy or distribute this software or documen- *) $(* tation in hard or soft copy granted only by written license *) $(* obtained from the Institute for Information Systems. *) $(*  *) $(******************************************************************) $ PROGRAM PASCALSYSTEM; (**************************O^**********************) (* *) (* UCSD PASCAL OPERATING SYSTEM *) (* *) (* RELEASE LEVEL: I.3 AUGUST, 1977 *) (* I.4 JANUARY, 197* PFILE,INOTCLOSED,INOTOPEN,IBADFORMAT, ISTRGOVFL); (*COMMAND STATES...SEE GETCMD*) CMDSTATE = (HALTINIT,DEBUGCALL,FIB = RECORD FWINDOW: WINDOWP; (*USER WINDOW...F^, USED BY GET-PUT*) FEOF,FEOLN: BOOLEAN; FSTATE: (FJANDW,FNEE UPROGNOU,UPROGUOK,SYSPROG, COMPONLY,COMPANDGO,COMPDEBUG, 1LINKANDGO,LINKDEBUG); (*ARCHIVAL INFO...THE DATE*) DCHAR,FGOTCHAR); FRECSIZE: INTEGER; (*IN BYTES...0=>BLOCKFILE, 1=>CHARFILE*) CASE FISOPEN: BOOLEAN OF  DATEREC = PACKED RECORD MONTH: 0..12; (*0 IMPLIES DATE NOT MEANINGFUL*) DAY: 0..31; (*DAY OF MONTH*) YEAR: 0..100 ( TRUE: (FISBLKD: BOOLEAN; (*FILE IS ON BLOCK DEVICE*) FUNIT: UNITNUM; (*PHYSICAL UNIT #*) FVID: VID; (*VO*100 IS TEMP DISK FLAG*) END (*DATEREC*) ; (*VOLUME TABLES*) UNITNUM = 0..MAXUNIT; VID = STRING[VIDLENG]LUME NAME*) FREPTCNT, (* # TIMES F^ VALID W/O GET*) FNXTBLK, (*NEXT REL BLOCK TO IO*) FMAXBLK: INTEGER; (*DISK DIRECTORIES*) DIRRANGE = 0..MAXDIR; TID = STRING[TIDLENG]; FILEKIND = (UNTYPEDFILE,XDSKFILE,CODEF; (*MAX REL BLOCK ACCESSED*) FMODIFIED:BOOLEAN;(*PLEASE SET NEW DATE IN CLOSE*) FHEADER: DIRENTRY;(*COPY OF DISKILE,TEXTFILE, INFOFILE,DATAFILE,GRAFFILE,FOTOFILE,SECUREDIR); DIRENTRY = RECORD DFIRSTBLK: INTEGER; (*FIRST PHYSICA DIR ENTRY*) CASE FSOFTBUF: BOOLEAN OF (*DISK GET-PUT STUFF*) TRUE: (FNXTBYTE,FMAXBYTE: INTEGER; FBUFCHNGD:* *) (* KENNETH L. BOWLES, DIRECTOR *) (* L DISK ADDR*) DLASTBLK: INTEGER; (*POINTS AT BLOCK FOLLOWING*) CASE DFKIND: FILEKIND OF SECUREDIR,  *) (************************************************) CONST MMAXINT = 32767; (*MAXIMUM INTEGER VALUE* UNTYPEDFILE: (*ONLY IN DIR[0]...VOLUME INFO*) (DVID: VID; (*NAME OF DISK VOLUME*) DEOVBLK: INTEGER; (*LASTBLK) MAXUNIT = 12; (*MAXIMUM PHYSICAL UNIT # FOR UREAD*) MAXDIR = 77; (*MAX NUMBER OF ENTRIES IN A DIRECTORY*) VIDLE OF VOLUME*) DNUMFILES: DIRRANGE; (*NUM FILES IN DIR*) DLOADTIME: INTEGER; (*TIME OF LAST ACCESS*) DLASTBOOT: DATEREC);NG = 7; (*NUMBER OF CHARS IN A VOLUME ID*) TIDLENG = 15; (*NUMBER OF CHARS IN TITLE ID*) MAXSEG = 15; (*MAX CODE SEGME (*MOST RECENT DATE SETTING*) XDSKFILE,CODEFILE,TEXTFILE,INFOFILE, DATAFILE,GRAFFILE,FOTOFILE: (DTID: TID; NT NUMBER*) FBLKSIZE = 512; (*STANDARD DISK BLOCK LENGTH*) DIRBLK = 2; (*DISK ADDR OF DIRECTORY*) AGELIMIT = 300; (*TITLE OF FILE*) DLASTBYTE: 1..FBLKSIZE; (*NUM BYTES IN LAST BLOCK*) DACCESS: DATEREC) (*LAST MODIFICATION DATE*) END  (*MAX AGE FOR GDIRP...IN TICKS*) EOL = 13; (*END-OF-LINE...ASCII CR*) DLE = 16; (*BLANK COMPRESSION CODE*) TYPE (*DIRENTRY*) ; DIRP = ^DIRECTORY; DIRECTORY = ARRAY [DIRRANGE] OF DIRENTRY; (*FILE INFORMATION*) CLOSETY IORSLTWD = (INOERROR,IBADBLOCK,IBADUNIT,IBADMODE,ITIMEOUT, ILOSTUNIT,ILOSTFILE,IBADTITLE,INOROOM,INOUNIT, INOFILE,IDUPE = (CNORMAL,CLOCK,CPURGE,CCRUNCH); WINDOWP = ^WINDOW; WINDOW = PACKED ARRAY [0..0] OF CHAR; FIBP = ^FIB; +  WORKTID,SYMTID,CODETID: TID (*PERM&CUR WORKFILES TITLE*) END (*INFOREC*) ; (*CODE SEGMENT LAYOUTS*) SEGRARL: PACKED RECORD RLF,NDFS,ERASEEOL,ERASEEOS,HOME,ESCAPE: CHAR; BACKSPACE: CHAR; FILLCOUNT: 0..255; NGE = 0..MAXSEG; SEGDESC = RECORD DISKADDR: INTEGER; (*REL BLK IN CODE...ABS IN SYSCOM^*) CODELENG: INTEGER (*# BYTES EXPANSION: PACKED ARRAY [0..3] OF CHAR END; CRTINFO: PACKED RECORD WIDTH,HEIGHT: INTEGER;  TO READ IN*) END (*SEGDESC*) ; (*DEBUGGER STUFF*) BYTERANGE = 0..255; TRICKARRAY = ARRAY [0..0] OF INTRIGHT,LEFT,DOWN,UP: CHAR; BADCH,CHARDEL,STOP,BREAK,FLUSH,EOF: CHAR; ALTMODE,LINEDEL: CHAR; EGER; (* FOR MEMORY DIDDLING*) MSCWP = ^ MSCW; (*MARK STACK RECORD POINTER*) MSCW = RECORD STATLINK: MSCWP; (* EXPANSION: PACKED ARRAY [0..5] OF CHAR END; SEGTABLE: ARRAY [SEGRANGE] OF RECORD CODEUNIT: UPOINTER TO PARENT MSCW*) DYNLINK: MSCWP; (*POINTER TO CALLER'S MSCW*) MSSEG,MSJTAB: ^TRICKARRAY; MSIPC: INTNITNUM; CODEDESC: SEGDESC END END (*SYSCOM*); MISCINFOREC = RECORD MSYSCOM: SYSCOMREC END; EGER; LOCALDATA: TRICKARRAY END (*MSCW*) ; (*SYSTEM COMMUNICATION AREA*) (*SEE INTERPRETERS...NOTE *) VAR SYSCOM: ^SYSCOMREC; (*MAGIC PARAM...SET UP IN BOOT*) GFILES: ARRAY [0..5] OF FIBP; (*GLOBAL FILES, 0=INPUT, 1=OUTP (*THAT WE ASSUME BACKWARD *) (*FIELD ALLOCATION IS DONE *) SYSCOMREC = RECORD IORSLT: IORSLTWD; (*RESULT OF LUT*) USERINFO: INFOREC; (*WORK STUFF FOR COMPILER ETC*) EMPTYHEAP: ^INTEGER; (*HEAP MARK FOR MEM MANAGING*) INPUTAST IO CALL*) XEQERR: INTEGER; (*REASON FOR EXECERROR CALL*) SYSUNIT: UNITNUM; (*PHYSICAL UNIT OF BOOTLOAD*) FIB,OUTPUTFIB, (*CONSOLE FILES...GFILES ARE COPIES*) SYSTERM,SWAPFIB: FIBP; (*CONTROL AND SWAPSPACE FILES*) SYVID,DKV BUGSTATE: INTEGER; (*DEBUGGER INFO*) GDIRP: DIRP; (*GLOBAL DIR POINTER,SEE VOLSEARCH*) LASTMP,STKBASE,BOMBP: MSCID: VID; (*SYSUNIT VOLID & DEFAULT VOLID*) THEDATE: DATEREC; (*TODAY...SET IN FILER OR SIGN ON*) DEBUGINFO: ^INTEGER BOOLEAN; FBUFFER: PACKED ARRAY [0..FBLKSIZE] OF CHAR)) END (*FIB*) ; (*USER WORKFILE STUFF*) INFOREC WP; MEMTOP,SEG,JTAB: INTEGER; BOMBIPC: INTEGER; (*WHERE XEQERR BLOWUP WAS*) HLTLINE: INTEGER; (*MORE DEBUGGER STU= RECORD SYMFIBP,CODEFIBP: FIBP; (*WORKFILES FOR SCRATCH*) ERRSYM,ERRBLK,ERRNUM: INTEGER; (*ERROR STUFF IN EDIT*) SLOWTFF*) BRKPTS: ARRAY [0..3] OF INTEGER; RETRIES: INTEGER; (*DRIVERS PUT RETRY COUNTS*) EXPANSION: ARRAY [0..8] OF IERM,STUPID: BOOLEAN; (*STUDENT PROGRAMMER ID!!*) ALTMODE: CHAR; (*WASHOUT CHAR FOR COMPILER*) GOTSYM,GOTCODE: BOOLEAN; (NTEGER; HIGHTIME,LOWTIME: INTEGER; MISCINFO: PACKED RECORD NOBREAK,STUPID,SLOWTERM, HASXYCRT,HASLC*TITLES ARE MEANINGFUL*) WORKVID,SYMVID,CODEVID: VID; (*PERM&CUR WORKFILE VOLUMES*) CRT,HAS8510A,HASCLOCK: BOOLEAN; USERKIND:(NORMAL, AQUIZ, BOOKER, PQUIZ) END; CRTTYPE: INTEGER; CRTCT, E STRING...SEE PROMPT*) IPOT: ARRAY [0..4] OF INTEGER; (*INTEGER POWERS OF TEN*) RE FREADLN(VAR F: FIB); FORWARD; PROCEDURE FWRITELN(VAR F: FIB); FORWARD; PROCEDURE SCONCAT(VAR DEST,SRC: STRING; DESTLENG:  FILLER: STRING[11]; (*NULLS FOR CARRIAGE DELAY*) DIGITS: SET OF '0'..'9'; UNITABLE: ARRAY [UNITNUM] OF (*0 NOT USEINTEGER); FORWARD; PROCEDURE SINSERT(VAR SRC,DEST: STRING; DESTLENG,INSINX: INTEGER); FORWARD; PROCEDURE SCOPY(VAR SRC,DEST:D*) RECORD UVID: VID; (*VOLUME ID FOR UNIT*) CASE UISBLKD: BOOLEAN OF TRUE: (UEOVBLK: INTEGER) END (*UNITABLE* STRING; SRCINX,COPYLENG: INTEGER); FORWARD; PROCEDURE SDELETE(VAR DEST: STRING; DELINX,DELLENG: INTEGER); FORWARD; FUNCTION) ; (*-------------------------------------------------------------------------*) (* SYSTEM PROCEDURE FORWARD DECLARATIONS *) ( SPOS(VAR TARGET,SRC: STRING): INTEGER; FORWARD; FUNCTION FBLOCKIO(VAR F: FIB; VAR A: WINDOW; * THESE ARE ADDRESSED BY OBJECT CODE... *) (* DO NOT MOVE WITHOUT CAREFUL THOUGHT *) PROCEDURE EXECERROR; FORWARD; PROCEDUR NBLOCKS,RBLOCK: INTEGER; DOREAD: BOOLEAN): INTEGER; FORWARD; PROCEDURE FGOTOXY(X,Y: INTEGER); FORWARD; (* NON FIXED FORE FINIT(VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER); FORWARD; PROCEDURE FRESET(VAR F: FIB); FORWARD; PROCEDURE FOPEN(VARWARD DECLARATIONS *) FUNCTION VOLSEARCH(VAR FVID: VID; LOOKHARD: BOOLEAN; VAR FDIR: DIRP): UNITNUM; FORWARD; PROCEDURE W F: FIB; VAR FTITLE: STRING; FOPENOLD: BOOLEAN; JUNK: FIBP); FORWARD; PROCEDURE FCLOSE(VAR F: FIB; FTYPE: CLOSETYPE); FORWRITEDIR(FUNIT: UNITNUM; FDIR: DIRP); FORWARD; FUNCTION DIRSEARCH(VAR FTID: TID; FINDPERM: BOOLEAN; FDIR: DIRP): DIRRANGE; FOARD; PROCEDURE FGET(VAR F: FIB); FORWARD; PROCEDURE FPUT(VAR F: FIB); FORWARD; PROCEDURE XSEEK; FORWARD; FUNCTION FEOF(VARRWARD; FUN