Home » Archimedes archive » Zipped Apps » BCPL » BCPL/b/root
BCPL/b/root
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
| Tape/disk: | Home » Archimedes archive » Zipped Apps » BCPL |
| Filename: | BCPL/b/root |
| Read OK: | ✔ |
| File size: | 4125 bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
File contents
SECTION "BCPL"
GET "b.Header"
STATIC {
// Version of 28 Feb 86 11:51:01
dummy = VersionMark
version = 1*256+2 };
LET Start() BE {
LET oldOutput = Output()
LET mark.syntrn = VEC mk.size-1
streams := 0
workVectors := 0
verStream := oldoutput
ocodeStream := 0
// Initialise the world and decode arguments: this routine sets up
// the 'primal.mark' used in opening streams.
cg := bcpl.args(mark.syntrn)
TEST sourceStream~=0 THEN {
LET keeptags = tagChain
{ LET mark = VEC mk.size-1
LET a = ?
MarkHeap(mark)
// The 'ocode.mark' is used when store for OCODE buffers is
// allocated: these are held AFTER the mark on the chain, and so
// will not be released until the heap is reset to the mark made
// above, after the CG phase. The heap is reset to 'ocode.mark'
// after the SYN and TRN phases, thus freeing the tree and
// declaration space.
ocode.mark := GetBlk(mk.size)
MarkHeap(ocode.mark)
SelectOutput(verStream)
a := bcpl.syn()
IF a=0 | rc>=20 THEN BREAK
WriteF("Tree size %N*N", space.used-mk.used!mark)
IF printTree THEN bcpl.ptree(a)
IF bcpl.trn(a)=0 THEN rc := 20
tagChain := keeptags
ResetHeap(ocode.mark)
IF (moduleStream~=0 | listStream~=0) & rc<=5 THEN bcpl.cg()
ResetHeap(mark)
} REPEATUNTIL ch=endStreamch | rc>=20
Close(sourceStream)
IF ocodeStream~=0 THEN Close(ocodeStream)
SelectOutput(verStream) }
ELSE IF ocodeFile~=0 THEN {
LET i = Input();
LET op = ?;
ocodeStream := Open(ocodeFile, TRUE, FALSE);
SelectInput(ocodeStream);
retainOcode := TRUE;
{ ocode.mark := GetBlk(mk.size)
MarkHeap(ocode.mark)
ocodeBuf := GetWithMark(oc.size, mark.syntrn)
ocodeBufs := ocodeBuf
oc.lastbyte!ocodeBuf := oc.firstbyte
oc.next!ocodeBuf := 0;
{ LET n = 0;
op := ReadN();
IF result2~=0 THEN BREAK;
Out1(op);
SWITCHON op INTO {
DEFAULT:
ENDCASE
CASE s.fnap:CASE s.rtap:
CASE s.lp: CASE s.lg: CASE s.ln: CASE s.ll:
CASE s.llp:CASE s.llg:CASE s.lll:
CASE s.sp: CASE s.sg: CASE s.sl:
CASE s.jump:CASE s.jt:CASE s.jf:CASE s.endfor:
CASE s.lab: CASE s.res:
CASE s.stack:CASE s.rstack:CASE s.save:
CASE s.datalab:CASE s.iteml:CASE s.itemn:
CASE s.endproc:
CASE s.linecount: CASE s.argno:
n := 1; ENDCASE
CASE s.fconst:
CASE s.dtab:
n := 2; ENDCASE
CASE s.slctap: CASE s.slctst:
n := 3; ENDCASE
CASE s.needs:
CASE s.section:
CASE s.lstr:
n := ReadN(); Out1(n); ENDCASE
CASE s.entry:
n := ReadN(); Out1(n); n := n+1; ENDCASE
CASE s.switchon:
n := ReadN(); Out1(n); n := 2*n+1; ENDCASE
CASE s.global:
n := ReadN(); Out1(n); n := 2*n; ENDCASE };
WHILE n>0 DO { Out1(ReadN()); n := n-1 }
} REPEATWHILE op~=s.global;
IF oc.lastbyte!ocodeBufs=oc.firstbyte THEN BREAK;
bcpl.cg();
ResetHeap(mark.syntrn)
} REPEAT;
SelectInput(i);
Close(ocodeStream) }
ResetHeap(mark.syntrn)
IF moduleStream~=0 THEN Close(moduleStream);
IF listStream~=0 THEN Close(listStream);
SelectOutput(verStream)
IF rc<=5 THEN
WriteF("Program size = %N bytes*N", programSize)
fail:
IF (CGDebugMode耀)~=0 THEN MapStore();
Exit(rc) }
AND SmallNumber(x) = 0<x<256 -> TRUE, FALSE
AND Exit(rc) BE {
WHILE streams~=0 DO Close(st.stream!streams)
WHILE workVectors~=0 DO FreeVector(workVectors+1)
Stop(rc) }
AND Complain(message, a, b, c) BE
Abandon(0, message, a, b, c)
AND Abandon(rc, message, a, b, c) BE {
SelectOutput(verStream)
WriteF(message, a, b, c)
result2 := rc
NewLine()
Exit(20) }
AND GetVector(size) = VALOF {
// Gets a vector of size (NOT upb) 'size'.
LET v = GetVec(size)
IF v=0 THEN Complain("ERROR: insufficient free store")
IF (-1)!v>=0 THEN Complain("GetVec bug")
!v := workVectors
workVectors := v
RESULTIS v+1 }
AND GetWithMark(size, mark) = VALOF {
// Allocates a new vector, and adds it to the chain AFTER the given mark.
LET v = GetVector(size)-1
LET vm = mk.vector!mark
workVectors := !v
!v := !vm
!vm := v
RESULTIS v+1 }
AND FreeVector(v) BE {
LET lv.c = @workVectors
v := v-1
WHILE !lv.c~=0 DO {
LET v1 = !lv.c
IF v1=v THEN {
!lv.c := !v1
FreeVec(v)
RETURN }
lv.c := v1 }
Complain("BUG: invalid freevector call") }
AND GetBlk(size) = VALOF {
LET p = ?
IF 2<=size<=free.max THEN {
p := freeLists!size;
IF p~=0 THEN {
freeLists!size := !p;
RESULTIS p } };
IF heapptr+size>heap.block.size THEN {
// Allocate 'large' vectors separately, to reduce fragmentation.
IF size>heap.block.size/4 THEN RESULTIS GetVector(size)
heap.block := GetVector(heap.block.size)
heapptr := 0 }
p := heapptr+heap.block
heapptr := heapptr+size
space.used := space.used+size
RESULTIS p }
AND MarkHeap(mark) BE {
mk.vector!mark := workVectors
mk.block!mark := heap.block
mk.ptr!mark := heapptr
mk.used!mark := space.used }
AND ResetHeap(mark) BE {
LET v = mk.vector!mark
WHILE workVectors~=v DO
FreeVector(workVectors+1);
FOR i = 2 TO free.max DO freeLists!i := 0;
heap.block := mk.block!mark
heapptr := mk.ptr!mark
space.used := mk.used!mark }
AND FreeBlk(p, size) = VALOF {
LET res = !p;
TEST 2<=size<=free.max THEN {
!p := freeLists!size;
freeLists!size := p }
ELSE
Complain("Bad call to FreeBlk: size = %n", size);
RESULTIS res }
AND FillBlk(n, a, b, c, d, e, f, g, h, i, j, k) = VALOF {
LET p = GetBlk(n);
FOR i = 1 TO n DO
(i-1)!p := i!@n;
RESULTIS p }
AND Open(file, input, binary) = VALOF {
// The store for the stream object is obtained by using
// 'getwithmark', quoting the 'primal.mark'. This is
// important because the OCODE stream may be opened in the
// TRN phase, AFTER the tree has been built. If the
// normal 'getvector' routine was used, the store for this
// stream would be freed after the translation was
// complete.
LET s = input -> FindInput(file), FindOutput(file)
IF s~=0 THEN {
LET str = GetWithMark(st.size, primal.mark)
LET name = GetWithMark((file%0)/BytesPerWord+1, primal.mark);
FOR i = 0 TO file%0 DO name%i := file%i;
st.stream!str := s;
st.input!str := input;
st.link!str := streams;
st.file!str := name;
streams := str }
RESULTIS s }
AND Close(stream) BE {
LET lv.str = @streams
LET str = streams
WHILE str~=0 & stream~=st.stream!str DO {
lv.str := st.link+str
str := !lv.str }
IF str=0 THEN Complain("BUG: bad close argument")
!lv.str := st.link!str
TEST st.input!str THEN {
LET i = Input()
SelectInput(stream)
EndRead()
IF i~=stream THEN SelectInput(i) }
ELSE {
LET o = Output();
SelectOutput(stream);
EndWrite();
IF stampFiles THEN Stamp(st.file!str);
IF o~=stream THEN SelectOutput(o) }
FreeVector(st.file!str);
FreeVector(str) }
AND Stamp(name) BE {
LET params = VEC 3;
LET dt = VEC 1;
BinaryTime(dt);
params!0 := #xffffff00 | (dt!1)
OSFile(2, name, params);
params!1 := dt!0;
OSFile(3, name, params) }
AND LookUpTag(string) = VALOF {
// Looks up the tag with the name given by the string,
// creating a new tag object (with value FALSE) if it is
// not found. The tag object is returned as the result.
LET t = tagChain
LET len = string%0
WHILE t~=0 DO {
IF CompString(string, tag.name+t)=0 THEN RESULTIS t
t := tag.link!t }
t := GetBlk(tag.name+len/BytesPerWord+1)
tag.link!t := tagChain
tagChain := t
tag.value!t := FALSE
FOR j = 0 TO len DO
(tag.name+t)%j := string%j
RESULTIS t }
.
SECTION "Args"
GET "b.Header"
MANIFEST {
argv.upb = 300;
// "FROM,TO=OBJ,OCODE/K,OPT/K,VER/K,LIST/K,HDR/K,CHARCODE/K"
a.from = 0
a.to = 1
a.ocode = 2
a.opt = 3
a.ver = 4
a.list = 5;
a.hdr = 6
a.charcode = 7 }
LET bcpl.args(mark) = VALOF {
// Called to initialise the world and decode the arguments
// of the BCPL compiler. The parameter is a heap mark
// vector which is used before allocating the store that
// is not required after the SYN and TRN phases.
//
// The order of allocation of store is important, and is
// as follows:
//
// VER stream
// OCODE file name vector
// Output code stream
// ------------- heap marked
// Others streams and vectors
// Tag name blocks from option string
//
LET sssset = FALSE
LET cg = 0
LET log = 0
LET bits = ?
LET argv = VEC argv.upb
LET s.front.end = "front end"
AND s.code.gen = "code generator"
AND s.not.recog = "not recognised"
AND s.not.preceded = "not preceded by + or -"
// Initialise storage and stream data: some of the
// initialisation has been done in the 'main' program.
heapptr := heap.block.size
space.used := 0
freeLists := GetVector(free.max)-1;
FOR i = 2 TO free.max DO freeLists!i := 0;
primal.mark := GetBlk(mk.size)
MarkHeap(primal.mark)
rc := 0
transchars := FALSE
lispExtensions := TRUE;
charCode := 0
headers := 0
sourceStream, listStream, moduleStream := 0, 0, 0;
programSize := 0
tagChain := 0
backwardVecs := FALSE;
printTree := FALSE;
procNames, naming := TRUE, FALSE;
callCounting, counting := FALSE, FALSE;
compactCode, AOFout := TRUE, FALSE;
rbInCalls := TRUE;
lispExtensions := TRUE;
stampFiles := TRUE;
CGDebugMode, CGOptMode := 0, 1;
restrictedLanguage := FALSE
extension.level := default.extension.level
equateCases := TRUE
retainOcode := TRUE
stkchking := FALSE
// Compute the machine dependent parameters for field
// selectors. 'bitswidth' is the number of bits in a
// BCPL cell on the target machine.
bitswidth := 32
bits := bitswidth-1
WHILE bits~=0 DO { log := log+1; bits := bits>>1 }
slct.size.shift := bitsperword-log
slct.shift.shift := slct.size.shift-log
slct.mask := (1<<log)-1
slct.max.offset := (1<<slct.shift.shift)-1
IF rdargs("FROM,TO=OBJ,OCODE/K,OPT/K,VER/K,LIST/K,HDR/K,CHARCODE/K",
argv, argv.upb)=0
THEN Complain("Bad args")
IF argv!a.ver~=0 THEN {
verStream := OpenStream(argv!a.ver, FALSE, FALSE)
SelectOutput(verStream) }
IF argv!a.list~=0 THEN
listStream := OpenStream(argv!a.list, FALSE, FALSE);
WriteF("ARM BCPL Version %n.%n*N", majorVersion, minorVersion)
IF argv!a.to~=0 THEN
moduleStream := OpenStream(argv!a.to, FALSE, TRUE)
ocodeFile := argv!a.ocode
IF ocodeFile~=0 THEN ocodeFile := NewString(ocodeFile)
// The store allocated above will be required for all
// phases of the compiler; that which is allocted next
// can be released after all the SYN and TRN phases.
// Thus the heap is marked now.
MarkHeap(mark)
tag.value ! LookupTag("ARM") := TRUE;
IF argv!a.charcode~=0 THEN {
LET stream = OpenStream(argv!a.charcode, TRUE, FALSE)
charCode := GetVector(128)
transchars := TRUE
SelectInput(stream)
FOR i = 0 TO 127 DO charCode!i := ReadCode()
Close(stream)
IF rc>0 THEN Complain("Error in CHARCODE table") }
IF argv!a.from~=0 THEN {
fromfile := NewString(argv!a.from)
sourceStream := OpenStream(fromfile, TRUE, FALSE) }
IF sourceStream=0 & ocodeFile=0 THEN
Complain("Nothing to compile")
// OPT parameter
//
// Compiler options:
//
// T print parse tree
// R 'restricted' language
// C equate cases
// Sn set savespace size
// B stack grows from high to low addresses -
// point vecs at the end, not beginning
// Xn set extension level to n
// $tag set tag to TRUE
// $tag' set tag to FALSE
// Dn - ignored -
// Ln - ignored -
//
// Code generator options:
//
// C stack checking
// N procedure names in code
// P profile and call counting
// K call counting
// Wn - ignored -
// X-Z machine dependent
//
// To allow for the $ (tag setting) option, options
// may now be separated by commas.
IF argv!a.opt~=0 THEN {
STATIC { optp = 0; opts = 0 };
LET found = FALSE
LET value = ?
LET rdn(optc, type) = VALOF {
LET n = 0
LET ok = FALSE;
WHILE optp<opts%0 DO {
LET ch = opts%(optp+1);
UNLESS '0'<=ch<='9' THEN BREAK;
optp := optp+1;
n := n*10 + ch-'0';
ok := TRUE };
IF ~ok THEN BadOpt(optc, type, "bad numeric argument")
RESULTIS n }
AND GetTag() BE {
// Called after $ has been found in the front end options.
LET l = 0
LET c = ?
LET v = VEC 255/BytesPerWord
WHILE optp<opts%0 DO {
c := CapitalCh(opts%(optp+1))
IF ~['A'<=c<='Z' | '0'<=c<='9'] THEN BREAK
l := l+1
optp := optp+1
v%l := c }
v%0 := l
TEST l=0 THEN
WriteS("Bad tag setting option*N")
ELSE {
LET t = LookUpTag(v)
TEST c='*'' THEN {
tag.value!t := FALSE
optp := optp+1 }
ELSE
tag.value!t := TRUE } }
AND BadOpt(ch, stage, message) BE
WriteF("Bad %S option *'%C*' - %S*N",
stage, ch, message)
opts := argv!a.opt;
optp := 1;
WHILE optp<=opts%0 DO {
LET lvOpt = 0
LET ch = opts%optp
SWITCHON CapitalCh(ch) INTO {
DEFAULT: BadOpt(ch, s.front.end, s.not.recog); ENDCASE
CASE ',': ENDCASE
CASE '+': value, found := TRUE, TRUE; ENDCASE
CASE '-': value, found := FALSE, TRUE; ENDCASE
CASE 'B': lvOpt := @backwardVecs; ENDCASE
CASE 'C': lvOpt := @equateCases; ENDCASE
CASE 'D': rdn(ch, s.front.end); ENDCASE
CASE 'H': lvOpt := @naming; ENDCASE
CASE 'L': lvopt := @lispExtensions; ENDCASE
CASE 'R': lvOpt := @restrictedLanguage; ENDCASE
CASE 'S': sssset := TRUE;
savespacesize := rdn(ch, s.front.end); ENDCASE
CASE 'T': lvOpt := @printtree; ENDCASE
CASE 'X': extension.level := rdn(ch, s.front.end); ENDCASE
CASE '$': GetTag(); ENDCASE
CASE '/': optp := optp+1; BREAK }
optp := optp+1;
IF lvOpt=0 THEN LOOP
TEST found
THEN !lvOpt := value
ELSE BadOpt(ch, s.front.end, s.not.preceded)
lvOpt := 0 }
// Check for code generator options
found := FALSE
WHILE optp<=opts%0 DO {
LET lvOpt = 0
LET ch = opts%optp
SWITCHON CapitalCh(ch) INTO {
DEFAULT: BadOpt(ch, s.code.gen, s.not.recog); ENDCASE
CASE ',': ENDCASE
CASE '+': value, found := TRUE, TRUE; ENDCASE
CASE '-': value, found := FALSE, TRUE; ENDCASE
CASE 'A': lvOpt := @AOFout; ENDCASE
CASE 'B': lvopt := @rbInCalls; ENDCASE
CASE 'C': lvOpt := @stkchking; ENDCASE
CASE 'D': CGDebugMode := rdn(ch, s.code.gen); ENDCASE
CASE 'K': lvOpt := @callcounting; ENDCASE
CASE 'N': lvOpt := @procNames; ENDCASE
CASE 'O': CGOptMode := RdN(ch, s.code.gen); ENDCASE
CASE 'P': lvOpt := @counting; ENDCASE
CASE 'S': lvOpt := @compactCode; ENDCASE
CASE 'W': rdn(ch, s.code.gen); ENDCASE;
CASE 'Z': lvOpt := @stampFiles; ENDCASE };
optp := optp+1
IF lvOpt=0 THEN LOOP
TEST found THEN
!lvOpt := value
ELSE
BadOpt(ch, s.code.gen, s.not.preceded)
lvOpt := 0 } };
IF ocodeFile~=0 THEN retainOcode := FALSE;
// HDR parameter (if read with /L, the length is given in the first word).
IF argv!a.hdr~=0 THEN
headers := NewString(argv!a.hdr)
IF sourceStream~=0 THEN {
SelectInput(sourceStream)
linecount := 1
trnlinecount := 1 }
IF ~sssset THEN savespacesize := 4
RESULTIS cg }
AND OpenStream(file, input, binary) = VALOF {
LET s = Open(file, input, binary)
IF s=0 THEN
Abandon(result2, "Can't open %S for %Sput",
file, (input -> "in", "out"))
RESULTIS s }
AND NewString(s) = s=0 -> 0, VALOF {
LET l = s%0
LET v = GetBlk(l / BytesPerWord+1)
FOR c = 0 TO l DO v%c := s%c
RESULTIS v }
AND ReadCode() = VALOF {
// Used to read code value for CHARCODE parameter.
//
// Value may be: ooo octal
// :xx hex
LET n = 0
LET ch = ' '
LET rx = 8
LET dc = 3
WHILE ch='*S' | ch='*T' | ch='*N' DO ch := rdch()
IF ch=':' THEN {
rx := 16; dc := 2; ch := rdch() }
FOR i = 1 TO dc DO {
LET c = CapitalCh(ch)
LET d = '0'<=c<='9' -> c-'0',
'A'<=c<='F' -> c-'A'+10, -1
TEST 0<=d<rx THEN
n := n*rx+d
ELSE {
rc := 10; BREAK }
ch := rdch() }
IF ~[ch='*S' | ch='*T' | ch='*N'] THEN rc := 10
unrdch()
RESULTIS n }
00000000 53 45 43 54 49 4f 4e 20 22 42 43 50 4c 22 0a 0a |SECTION "BCPL"..|
00000010 47 45 54 20 22 62 2e 48 65 61 64 65 72 22 0a 0a |GET "b.Header"..|
00000020 53 54 41 54 49 43 20 7b 0a 2f 2f 20 56 65 72 73 |STATIC {.// Vers|
00000030 69 6f 6e 20 6f 66 20 32 38 20 46 65 62 20 38 36 |ion of 28 Feb 86|
00000040 20 31 31 3a 35 31 3a 30 31 0a 20 20 20 64 75 6d | 11:51:01. dum|
00000050 6d 79 20 3d 20 56 65 72 73 69 6f 6e 4d 61 72 6b |my = VersionMark|
00000060 0a 20 20 20 76 65 72 73 69 6f 6e 20 3d 20 31 2a |. version = 1*|
00000070 32 35 36 2b 32 20 7d 3b 0a 0a 4c 45 54 20 53 74 |256+2 };..LET St|
00000080 61 72 74 28 29 20 42 45 20 7b 0a 20 20 20 4c 45 |art() BE {. LE|
00000090 54 20 6f 6c 64 4f 75 74 70 75 74 20 3d 20 4f 75 |T oldOutput = Ou|
000000a0 74 70 75 74 28 29 0a 20 20 20 4c 45 54 20 6d 61 |tput(). LET ma|
000000b0 72 6b 2e 73 79 6e 74 72 6e 20 3d 20 56 45 43 20 |rk.syntrn = VEC |
000000c0 6d 6b 2e 73 69 7a 65 2d 31 0a 0a 20 20 20 73 74 |mk.size-1.. st|
000000d0 72 65 61 6d 73 20 3a 3d 20 30 0a 20 20 20 77 6f |reams := 0. wo|
000000e0 72 6b 56 65 63 74 6f 72 73 20 3a 3d 20 30 0a 20 |rkVectors := 0. |
000000f0 20 20 76 65 72 53 74 72 65 61 6d 20 3a 3d 20 6f | verStream := o|
00000100 6c 64 6f 75 74 70 75 74 0a 20 20 20 6f 63 6f 64 |ldoutput. ocod|
00000110 65 53 74 72 65 61 6d 20 3a 3d 20 30 0a 0a 20 20 |eStream := 0.. |
00000120 20 2f 2f 20 49 6e 69 74 69 61 6c 69 73 65 20 74 | // Initialise t|
00000130 68 65 20 77 6f 72 6c 64 20 61 6e 64 20 64 65 63 |he world and dec|
00000140 6f 64 65 20 61 72 67 75 6d 65 6e 74 73 3a 20 74 |ode arguments: t|
00000150 68 69 73 20 72 6f 75 74 69 6e 65 20 73 65 74 73 |his routine sets|
00000160 20 75 70 0a 20 20 20 2f 2f 20 74 68 65 20 27 70 | up. // the 'p|
00000170 72 69 6d 61 6c 2e 6d 61 72 6b 27 20 75 73 65 64 |rimal.mark' used|
00000180 20 69 6e 20 6f 70 65 6e 69 6e 67 20 73 74 72 65 | in opening stre|
00000190 61 6d 73 2e 0a 0a 20 20 20 63 67 20 3a 3d 20 62 |ams... cg := b|
000001a0 63 70 6c 2e 61 72 67 73 28 6d 61 72 6b 2e 73 79 |cpl.args(mark.sy|
000001b0 6e 74 72 6e 29 0a 0a 20 20 20 54 45 53 54 20 73 |ntrn).. TEST s|
000001c0 6f 75 72 63 65 53 74 72 65 61 6d 7e 3d 30 20 54 |ourceStream~=0 T|
000001d0 48 45 4e 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 |HEN {. LET |
000001e0 6b 65 65 70 74 61 67 73 20 3d 20 74 61 67 43 68 |keeptags = tagCh|
000001f0 61 69 6e 0a 0a 20 20 20 20 20 20 7b 20 20 4c 45 |ain.. { LE|
00000200 54 20 6d 61 72 6b 20 3d 20 56 45 43 20 6d 6b 2e |T mark = VEC mk.|
00000210 73 69 7a 65 2d 31 0a 09 20 4c 45 54 20 61 09 20 |size-1.. LET a. |
00000220 20 3d 20 3f 0a 09 20 4d 61 72 6b 48 65 61 70 28 | = ?.. MarkHeap(|
00000230 6d 61 72 6b 29 0a 0a 09 20 2f 2f 20 54 68 65 20 |mark)... // The |
00000240 27 6f 63 6f 64 65 2e 6d 61 72 6b 27 20 69 73 20 |'ocode.mark' is |
00000250 75 73 65 64 20 77 68 65 6e 20 73 74 6f 72 65 20 |used when store |
00000260 66 6f 72 20 4f 43 4f 44 45 20 62 75 66 66 65 72 |for OCODE buffer|
00000270 73 20 69 73 0a 09 20 2f 2f 20 61 6c 6c 6f 63 61 |s is.. // alloca|
00000280 74 65 64 3a 20 74 68 65 73 65 20 61 72 65 20 68 |ted: these are h|
00000290 65 6c 64 20 41 46 54 45 52 20 74 68 65 20 6d 61 |eld AFTER the ma|
000002a0 72 6b 20 6f 6e 20 74 68 65 20 63 68 61 69 6e 2c |rk on the chain,|
000002b0 20 61 6e 64 20 73 6f 0a 09 20 2f 2f 20 77 69 6c | and so.. // wil|
000002c0 6c 20 6e 6f 74 20 62 65 20 72 65 6c 65 61 73 65 |l not be release|
000002d0 64 20 75 6e 74 69 6c 20 74 68 65 20 68 65 61 70 |d until the heap|
000002e0 20 69 73 20 72 65 73 65 74 20 74 6f 20 74 68 65 | is reset to the|
000002f0 20 6d 61 72 6b 20 6d 61 64 65 0a 09 20 2f 2f 20 | mark made.. // |
00000300 61 62 6f 76 65 2c 20 61 66 74 65 72 20 74 68 65 |above, after the|
00000310 20 43 47 20 70 68 61 73 65 2e 09 54 68 65 20 68 | CG phase..The h|
00000320 65 61 70 20 69 73 20 72 65 73 65 74 20 74 6f 20 |eap is reset to |
00000330 27 6f 63 6f 64 65 2e 6d 61 72 6b 27 0a 09 20 2f |'ocode.mark'.. /|
00000340 2f 20 61 66 74 65 72 20 74 68 65 20 53 59 4e 20 |/ after the SYN |
00000350 61 6e 64 20 54 52 4e 20 70 68 61 73 65 73 2c 20 |and TRN phases, |
00000360 74 68 75 73 20 66 72 65 65 69 6e 67 20 74 68 65 |thus freeing the|
00000370 20 74 72 65 65 20 61 6e 64 0a 09 20 2f 2f 20 64 | tree and.. // d|
00000380 65 63 6c 61 72 61 74 69 6f 6e 20 73 70 61 63 65 |eclaration space|
00000390 2e 0a 0a 09 20 6f 63 6f 64 65 2e 6d 61 72 6b 20 |.... ocode.mark |
000003a0 3a 3d 20 47 65 74 42 6c 6b 28 6d 6b 2e 73 69 7a |:= GetBlk(mk.siz|
000003b0 65 29 0a 09 20 4d 61 72 6b 48 65 61 70 28 6f 63 |e).. MarkHeap(oc|
000003c0 6f 64 65 2e 6d 61 72 6b 29 0a 0a 09 20 53 65 6c |ode.mark)... Sel|
000003d0 65 63 74 4f 75 74 70 75 74 28 76 65 72 53 74 72 |ectOutput(verStr|
000003e0 65 61 6d 29 0a 0a 09 20 61 20 3a 3d 20 62 63 70 |eam)... a := bcp|
000003f0 6c 2e 73 79 6e 28 29 0a 09 20 49 46 20 61 3d 30 |l.syn().. IF a=0|
00000400 20 7c 20 72 63 3e 3d 32 30 20 54 48 45 4e 20 42 | | rc>=20 THEN B|
00000410 52 45 41 4b 0a 0a 09 20 57 72 69 74 65 46 28 22 |REAK... WriteF("|
00000420 54 72 65 65 20 73 69 7a 65 20 25 4e 2a 4e 22 2c |Tree size %N*N",|
00000430 20 73 70 61 63 65 2e 75 73 65 64 2d 6d 6b 2e 75 | space.used-mk.u|
00000440 73 65 64 21 6d 61 72 6b 29 0a 0a 09 20 49 46 20 |sed!mark)... IF |
00000450 70 72 69 6e 74 54 72 65 65 20 54 48 45 4e 20 62 |printTree THEN b|
00000460 63 70 6c 2e 70 74 72 65 65 28 61 29 0a 0a 09 20 |cpl.ptree(a)... |
00000470 49 46 20 62 63 70 6c 2e 74 72 6e 28 61 29 3d 30 |IF bcpl.trn(a)=0|
00000480 20 54 48 45 4e 20 72 63 20 3a 3d 20 32 30 0a 0a | THEN rc := 20..|
00000490 09 20 74 61 67 43 68 61 69 6e 20 3a 3d 20 6b 65 |. tagChain := ke|
000004a0 65 70 74 61 67 73 0a 09 20 52 65 73 65 74 48 65 |eptags.. ResetHe|
000004b0 61 70 28 6f 63 6f 64 65 2e 6d 61 72 6b 29 0a 0a |ap(ocode.mark)..|
000004c0 09 20 49 46 20 28 6d 6f 64 75 6c 65 53 74 72 65 |. IF (moduleStre|
000004d0 61 6d 7e 3d 30 20 7c 20 6c 69 73 74 53 74 72 65 |am~=0 | listStre|
000004e0 61 6d 7e 3d 30 29 20 26 20 72 63 3c 3d 35 20 54 |am~=0) & rc<=5 T|
000004f0 48 45 4e 20 62 63 70 6c 2e 63 67 28 29 0a 0a 09 |HEN bcpl.cg()...|
00000500 20 52 65 73 65 74 48 65 61 70 28 6d 61 72 6b 29 | ResetHeap(mark)|
00000510 0a 20 20 20 20 20 20 7d 20 52 45 50 45 41 54 55 |. } REPEATU|
00000520 4e 54 49 4c 20 63 68 3d 65 6e 64 53 74 72 65 61 |NTIL ch=endStrea|
00000530 6d 63 68 20 7c 20 72 63 3e 3d 32 30 0a 0a 20 20 |mch | rc>=20.. |
00000540 20 20 20 20 43 6c 6f 73 65 28 73 6f 75 72 63 65 | Close(source|
00000550 53 74 72 65 61 6d 29 0a 20 20 20 20 20 20 49 46 |Stream). IF|
00000560 20 6f 63 6f 64 65 53 74 72 65 61 6d 7e 3d 30 20 | ocodeStream~=0 |
00000570 54 48 45 4e 20 43 6c 6f 73 65 28 6f 63 6f 64 65 |THEN Close(ocode|
00000580 53 74 72 65 61 6d 29 0a 0a 20 20 20 20 20 20 53 |Stream).. S|
00000590 65 6c 65 63 74 4f 75 74 70 75 74 28 76 65 72 53 |electOutput(verS|
000005a0 74 72 65 61 6d 29 20 7d 0a 0a 20 20 20 45 4c 53 |tream) }.. ELS|
000005b0 45 20 49 46 20 6f 63 6f 64 65 46 69 6c 65 7e 3d |E IF ocodeFile~=|
000005c0 30 20 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 4c |0 THEN {. L|
000005d0 45 54 20 69 20 3d 20 49 6e 70 75 74 28 29 3b 0a |ET i = Input();.|
000005e0 20 20 20 20 20 20 4c 45 54 20 6f 70 20 3d 20 3f | LET op = ?|
000005f0 3b 0a 20 20 20 20 20 20 6f 63 6f 64 65 53 74 72 |;. ocodeStr|
00000600 65 61 6d 20 3a 3d 20 4f 70 65 6e 28 6f 63 6f 64 |eam := Open(ocod|
00000610 65 46 69 6c 65 2c 20 54 52 55 45 2c 20 46 41 4c |eFile, TRUE, FAL|
00000620 53 45 29 3b 0a 20 20 20 20 20 20 53 65 6c 65 63 |SE);. Selec|
00000630 74 49 6e 70 75 74 28 6f 63 6f 64 65 53 74 72 65 |tInput(ocodeStre|
00000640 61 6d 29 3b 0a 20 20 20 20 20 20 72 65 74 61 69 |am);. retai|
00000650 6e 4f 63 6f 64 65 20 3a 3d 20 54 52 55 45 3b 0a |nOcode := TRUE;.|
00000660 0a 20 20 20 20 20 20 7b 20 20 6f 63 6f 64 65 2e |. { ocode.|
00000670 6d 61 72 6b 20 3a 3d 20 47 65 74 42 6c 6b 28 6d |mark := GetBlk(m|
00000680 6b 2e 73 69 7a 65 29 0a 09 20 4d 61 72 6b 48 65 |k.size).. MarkHe|
00000690 61 70 28 6f 63 6f 64 65 2e 6d 61 72 6b 29 0a 09 |ap(ocode.mark)..|
000006a0 20 6f 63 6f 64 65 42 75 66 20 3a 3d 20 47 65 74 | ocodeBuf := Get|
000006b0 57 69 74 68 4d 61 72 6b 28 6f 63 2e 73 69 7a 65 |WithMark(oc.size|
000006c0 2c 20 6d 61 72 6b 2e 73 79 6e 74 72 6e 29 0a 09 |, mark.syntrn)..|
000006d0 20 6f 63 6f 64 65 42 75 66 73 20 3a 3d 20 6f 63 | ocodeBufs := oc|
000006e0 6f 64 65 42 75 66 0a 09 20 6f 63 2e 6c 61 73 74 |odeBuf.. oc.last|
000006f0 62 79 74 65 21 6f 63 6f 64 65 42 75 66 20 3a 3d |byte!ocodeBuf :=|
00000700 20 6f 63 2e 66 69 72 73 74 62 79 74 65 0a 09 20 | oc.firstbyte.. |
00000710 6f 63 2e 6e 65 78 74 21 6f 63 6f 64 65 42 75 66 |oc.next!ocodeBuf|
00000720 20 3a 3d 20 30 3b 0a 0a 09 20 7b 20 20 4c 45 54 | := 0;... { LET|
00000730 20 6e 20 3d 20 30 3b 0a 09 20 20 20 20 6f 70 20 | n = 0;.. op |
00000740 3a 3d 20 52 65 61 64 4e 28 29 3b 0a 09 20 20 20 |:= ReadN();.. |
00000750 20 49 46 20 72 65 73 75 6c 74 32 7e 3d 30 20 54 | IF result2~=0 T|
00000760 48 45 4e 20 42 52 45 41 4b 3b 0a 09 20 20 20 20 |HEN BREAK;.. |
00000770 4f 75 74 31 28 6f 70 29 3b 0a 09 20 20 20 20 53 |Out1(op);.. S|
00000780 57 49 54 43 48 4f 4e 20 6f 70 20 49 4e 54 4f 20 |WITCHON op INTO |
00000790 7b 0a 09 20 20 20 20 20 20 20 44 45 46 41 55 4c |{.. DEFAUL|
000007a0 54 3a 0a 09 09 20 20 45 4e 44 43 41 53 45 0a 09 |T:... ENDCASE..|
000007b0 20 20 20 20 20 20 20 43 41 53 45 20 73 2e 66 6e | CASE s.fn|
000007c0 61 70 3a 43 41 53 45 20 73 2e 72 74 61 70 3a 0a |ap:CASE s.rtap:.|
000007d0 09 20 20 20 20 20 20 20 43 41 53 45 20 73 2e 6c |. CASE s.l|
000007e0 70 3a 20 43 41 53 45 20 73 2e 6c 67 3a 20 43 41 |p: CASE s.lg: CA|
000007f0 53 45 20 73 2e 6c 6e 3a 20 43 41 53 45 20 73 2e |SE s.ln: CASE s.|
00000800 6c 6c 3a 0a 09 20 20 20 20 20 20 20 43 41 53 45 |ll:.. CASE|
00000810 20 73 2e 6c 6c 70 3a 43 41 53 45 20 73 2e 6c 6c | s.llp:CASE s.ll|
00000820 67 3a 43 41 53 45 20 73 2e 6c 6c 6c 3a 0a 09 20 |g:CASE s.lll:.. |
00000830 20 20 20 20 20 20 43 41 53 45 20 73 2e 73 70 3a | CASE s.sp:|
00000840 20 43 41 53 45 20 73 2e 73 67 3a 20 43 41 53 45 | CASE s.sg: CASE|
00000850 20 73 2e 73 6c 3a 0a 09 20 20 20 20 20 20 20 43 | s.sl:.. C|
00000860 41 53 45 20 73 2e 6a 75 6d 70 3a 43 41 53 45 20 |ASE s.jump:CASE |
00000870 73 2e 6a 74 3a 43 41 53 45 20 73 2e 6a 66 3a 43 |s.jt:CASE s.jf:C|
00000880 41 53 45 20 73 2e 65 6e 64 66 6f 72 3a 0a 09 20 |ASE s.endfor:.. |
00000890 20 20 20 20 20 20 43 41 53 45 20 73 2e 6c 61 62 | CASE s.lab|
000008a0 3a 20 43 41 53 45 20 73 2e 72 65 73 3a 0a 09 20 |: CASE s.res:.. |
000008b0 20 20 20 20 20 20 43 41 53 45 20 73 2e 73 74 61 | CASE s.sta|
000008c0 63 6b 3a 43 41 53 45 20 73 2e 72 73 74 61 63 6b |ck:CASE s.rstack|
000008d0 3a 43 41 53 45 20 73 2e 73 61 76 65 3a 0a 09 20 |:CASE s.save:.. |
000008e0 20 20 20 20 20 20 43 41 53 45 20 73 2e 64 61 74 | CASE s.dat|
000008f0 61 6c 61 62 3a 43 41 53 45 20 73 2e 69 74 65 6d |alab:CASE s.item|
00000900 6c 3a 43 41 53 45 20 73 2e 69 74 65 6d 6e 3a 0a |l:CASE s.itemn:.|
00000910 09 20 20 20 20 20 20 20 43 41 53 45 20 73 2e 65 |. CASE s.e|
00000920 6e 64 70 72 6f 63 3a 0a 09 20 20 20 20 20 20 20 |ndproc:.. |
00000930 43 41 53 45 20 73 2e 6c 69 6e 65 63 6f 75 6e 74 |CASE s.linecount|
00000940 3a 20 43 41 53 45 20 73 2e 61 72 67 6e 6f 3a 0a |: CASE s.argno:.|
00000950 09 09 20 20 6e 20 3a 3d 20 31 3b 20 45 4e 44 43 |.. n := 1; ENDC|
00000960 41 53 45 0a 09 20 20 20 20 20 20 20 43 41 53 45 |ASE.. CASE|
00000970 20 73 2e 66 63 6f 6e 73 74 3a 0a 09 20 20 20 20 | s.fconst:.. |
00000980 20 20 20 43 41 53 45 20 73 2e 64 74 61 62 3a 0a | CASE s.dtab:.|
00000990 09 09 20 20 6e 20 3a 3d 20 32 3b 20 45 4e 44 43 |.. n := 2; ENDC|
000009a0 41 53 45 0a 09 20 20 20 20 20 20 20 43 41 53 45 |ASE.. CASE|
000009b0 20 73 2e 73 6c 63 74 61 70 3a 20 43 41 53 45 20 | s.slctap: CASE |
000009c0 73 2e 73 6c 63 74 73 74 3a 0a 09 09 20 20 6e 20 |s.slctst:... n |
000009d0 3a 3d 20 33 3b 20 45 4e 44 43 41 53 45 0a 09 20 |:= 3; ENDCASE.. |
000009e0 20 20 20 20 20 20 43 41 53 45 20 73 2e 6e 65 65 | CASE s.nee|
000009f0 64 73 3a 0a 09 20 20 20 20 20 20 20 43 41 53 45 |ds:.. CASE|
00000a00 20 73 2e 73 65 63 74 69 6f 6e 3a 0a 09 20 20 20 | s.section:.. |
00000a10 20 20 20 20 43 41 53 45 20 73 2e 6c 73 74 72 3a | CASE s.lstr:|
00000a20 0a 09 09 20 20 6e 20 3a 3d 20 52 65 61 64 4e 28 |... n := ReadN(|
00000a30 29 3b 20 4f 75 74 31 28 6e 29 3b 20 45 4e 44 43 |); Out1(n); ENDC|
00000a40 41 53 45 0a 09 20 20 20 20 20 20 20 43 41 53 45 |ASE.. CASE|
00000a50 20 73 2e 65 6e 74 72 79 3a 0a 09 09 20 20 6e 20 | s.entry:... n |
00000a60 3a 3d 20 52 65 61 64 4e 28 29 3b 20 4f 75 74 31 |:= ReadN(); Out1|
00000a70 28 6e 29 3b 20 6e 20 3a 3d 20 6e 2b 31 3b 20 45 |(n); n := n+1; E|
00000a80 4e 44 43 41 53 45 0a 09 20 20 20 20 20 20 20 43 |NDCASE.. C|
00000a90 41 53 45 20 73 2e 73 77 69 74 63 68 6f 6e 3a 0a |ASE s.switchon:.|
00000aa0 09 09 20 20 6e 20 3a 3d 20 52 65 61 64 4e 28 29 |.. n := ReadN()|
00000ab0 3b 20 4f 75 74 31 28 6e 29 3b 20 6e 20 3a 3d 20 |; Out1(n); n := |
00000ac0 32 2a 6e 2b 31 3b 20 45 4e 44 43 41 53 45 0a 09 |2*n+1; ENDCASE..|
00000ad0 20 20 20 20 20 20 20 43 41 53 45 20 73 2e 67 6c | CASE s.gl|
00000ae0 6f 62 61 6c 3a 0a 09 09 20 20 6e 20 3a 3d 20 52 |obal:... n := R|
00000af0 65 61 64 4e 28 29 3b 20 4f 75 74 31 28 6e 29 3b |eadN(); Out1(n);|
00000b00 20 6e 20 3a 3d 20 32 2a 6e 3b 20 45 4e 44 43 41 | n := 2*n; ENDCA|
00000b10 53 45 20 7d 3b 0a 09 20 20 20 20 57 48 49 4c 45 |SE };.. WHILE|
00000b20 20 6e 3e 30 20 44 4f 20 7b 20 4f 75 74 31 28 52 | n>0 DO { Out1(R|
00000b30 65 61 64 4e 28 29 29 3b 20 6e 20 3a 3d 20 6e 2d |eadN()); n := n-|
00000b40 31 20 7d 0a 09 20 7d 20 52 45 50 45 41 54 57 48 |1 }.. } REPEATWH|
00000b50 49 4c 45 20 6f 70 7e 3d 73 2e 67 6c 6f 62 61 6c |ILE op~=s.global|
00000b60 3b 0a 0a 09 20 49 46 20 6f 63 2e 6c 61 73 74 62 |;... IF oc.lastb|
00000b70 79 74 65 21 6f 63 6f 64 65 42 75 66 73 3d 6f 63 |yte!ocodeBufs=oc|
00000b80 2e 66 69 72 73 74 62 79 74 65 20 54 48 45 4e 20 |.firstbyte THEN |
00000b90 42 52 45 41 4b 3b 0a 09 20 62 63 70 6c 2e 63 67 |BREAK;.. bcpl.cg|
00000ba0 28 29 3b 0a 09 20 52 65 73 65 74 48 65 61 70 28 |();.. ResetHeap(|
00000bb0 6d 61 72 6b 2e 73 79 6e 74 72 6e 29 0a 20 20 20 |mark.syntrn). |
00000bc0 20 20 20 7d 20 52 45 50 45 41 54 3b 0a 20 20 20 | } REPEAT;. |
00000bd0 20 20 20 53 65 6c 65 63 74 49 6e 70 75 74 28 69 | SelectInput(i|
00000be0 29 3b 0a 20 20 20 20 20 20 43 6c 6f 73 65 28 6f |);. Close(o|
00000bf0 63 6f 64 65 53 74 72 65 61 6d 29 20 7d 0a 0a 20 |codeStream) }.. |
00000c00 20 20 52 65 73 65 74 48 65 61 70 28 6d 61 72 6b | ResetHeap(mark|
00000c10 2e 73 79 6e 74 72 6e 29 0a 0a 20 20 20 49 46 20 |.syntrn).. IF |
00000c20 6d 6f 64 75 6c 65 53 74 72 65 61 6d 7e 3d 30 20 |moduleStream~=0 |
00000c30 54 48 45 4e 20 43 6c 6f 73 65 28 6d 6f 64 75 6c |THEN Close(modul|
00000c40 65 53 74 72 65 61 6d 29 3b 0a 20 20 20 49 46 20 |eStream);. IF |
00000c50 6c 69 73 74 53 74 72 65 61 6d 7e 3d 30 20 54 48 |listStream~=0 TH|
00000c60 45 4e 20 43 6c 6f 73 65 28 6c 69 73 74 53 74 72 |EN Close(listStr|
00000c70 65 61 6d 29 3b 0a 0a 20 20 20 53 65 6c 65 63 74 |eam);.. Select|
00000c80 4f 75 74 70 75 74 28 76 65 72 53 74 72 65 61 6d |Output(verStream|
00000c90 29 0a 0a 20 20 20 49 46 20 72 63 3c 3d 35 20 54 |).. IF rc<=5 T|
00000ca0 48 45 4e 0a 20 20 20 20 20 20 57 72 69 74 65 46 |HEN. WriteF|
00000cb0 28 22 50 72 6f 67 72 61 6d 20 73 69 7a 65 20 3d |("Program size =|
00000cc0 20 25 4e 20 62 79 74 65 73 2a 4e 22 2c 20 70 72 | %N bytes*N", pr|
00000cd0 6f 67 72 61 6d 53 69 7a 65 29 0a 0a 66 61 69 6c |ogramSize)..fail|
00000ce0 3a 0a 20 20 20 49 46 20 28 43 47 44 65 62 75 67 |:. IF (CGDebug|
00000cf0 4d 6f 64 65 26 23 78 38 30 30 30 29 7e 3d 30 20 |Mode耀)~=0 |
00000d00 54 48 45 4e 20 4d 61 70 53 74 6f 72 65 28 29 3b |THEN MapStore();|
00000d10 0a 20 20 20 45 78 69 74 28 72 63 29 20 7d 0a 0a |. Exit(rc) }..|
00000d20 41 4e 44 20 53 6d 61 6c 6c 4e 75 6d 62 65 72 28 |AND SmallNumber(|
00000d30 78 29 20 3d 20 20 30 3c 78 3c 32 35 36 20 2d 3e |x) = 0<x<256 ->|
00000d40 20 54 52 55 45 2c 20 46 41 4c 53 45 0a 0a 41 4e | TRUE, FALSE..AN|
00000d50 44 20 45 78 69 74 28 72 63 29 20 42 45 20 7b 0a |D Exit(rc) BE {.|
00000d60 20 20 20 57 48 49 4c 45 20 73 74 72 65 61 6d 73 | WHILE streams|
00000d70 7e 3d 30 20 44 4f 20 43 6c 6f 73 65 28 73 74 2e |~=0 DO Close(st.|
00000d80 73 74 72 65 61 6d 21 73 74 72 65 61 6d 73 29 0a |stream!streams).|
00000d90 20 20 20 57 48 49 4c 45 20 77 6f 72 6b 56 65 63 | WHILE workVec|
00000da0 74 6f 72 73 7e 3d 30 20 44 4f 20 46 72 65 65 56 |tors~=0 DO FreeV|
00000db0 65 63 74 6f 72 28 77 6f 72 6b 56 65 63 74 6f 72 |ector(workVector|
00000dc0 73 2b 31 29 0a 20 20 20 53 74 6f 70 28 72 63 29 |s+1). Stop(rc)|
00000dd0 20 7d 0a 0a 41 4e 44 20 43 6f 6d 70 6c 61 69 6e | }..AND Complain|
00000de0 28 6d 65 73 73 61 67 65 2c 20 61 2c 20 62 2c 20 |(message, a, b, |
00000df0 63 29 20 42 45 0a 20 20 41 62 61 6e 64 6f 6e 28 |c) BE. Abandon(|
00000e00 30 2c 20 6d 65 73 73 61 67 65 2c 20 61 2c 20 62 |0, message, a, b|
00000e10 2c 20 63 29 0a 0a 41 4e 44 20 41 62 61 6e 64 6f |, c)..AND Abando|
00000e20 6e 28 72 63 2c 20 6d 65 73 73 61 67 65 2c 20 61 |n(rc, message, a|
00000e30 2c 20 62 2c 20 63 29 20 42 45 20 7b 0a 20 20 20 |, b, c) BE {. |
00000e40 53 65 6c 65 63 74 4f 75 74 70 75 74 28 76 65 72 |SelectOutput(ver|
00000e50 53 74 72 65 61 6d 29 0a 20 20 20 57 72 69 74 65 |Stream). Write|
00000e60 46 28 6d 65 73 73 61 67 65 2c 20 61 2c 20 62 2c |F(message, a, b,|
00000e70 20 63 29 0a 20 20 20 72 65 73 75 6c 74 32 20 3a | c). result2 :|
00000e80 3d 20 72 63 0a 20 20 20 4e 65 77 4c 69 6e 65 28 |= rc. NewLine(|
00000e90 29 0a 20 20 20 45 78 69 74 28 32 30 29 20 7d 0a |). Exit(20) }.|
00000ea0 0a 41 4e 44 20 47 65 74 56 65 63 74 6f 72 28 73 |.AND GetVector(s|
00000eb0 69 7a 65 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 2f |ize) = VALOF {./|
00000ec0 2f 20 47 65 74 73 20 61 20 76 65 63 74 6f 72 20 |/ Gets a vector |
00000ed0 6f 66 20 73 69 7a 65 20 28 4e 4f 54 20 75 70 62 |of size (NOT upb|
00000ee0 29 20 27 73 69 7a 65 27 2e 0a 20 20 20 4c 45 54 |) 'size'.. LET|
00000ef0 20 76 20 3d 20 47 65 74 56 65 63 28 73 69 7a 65 | v = GetVec(size|
00000f00 29 0a 0a 20 20 20 49 46 20 76 3d 30 20 54 48 45 |).. IF v=0 THE|
00000f10 4e 20 43 6f 6d 70 6c 61 69 6e 28 22 45 52 52 4f |N Complain("ERRO|
00000f20 52 3a 20 69 6e 73 75 66 66 69 63 69 65 6e 74 20 |R: insufficient |
00000f30 66 72 65 65 20 73 74 6f 72 65 22 29 0a 20 20 20 |free store"). |
00000f40 49 46 20 28 2d 31 29 21 76 3e 3d 30 20 54 48 45 |IF (-1)!v>=0 THE|
00000f50 4e 20 43 6f 6d 70 6c 61 69 6e 28 22 47 65 74 56 |N Complain("GetV|
00000f60 65 63 20 62 75 67 22 29 0a 20 20 20 21 76 20 3a |ec bug"). !v :|
00000f70 3d 20 77 6f 72 6b 56 65 63 74 6f 72 73 0a 20 20 |= workVectors. |
00000f80 20 77 6f 72 6b 56 65 63 74 6f 72 73 20 3a 3d 20 | workVectors := |
00000f90 76 0a 20 20 20 52 45 53 55 4c 54 49 53 20 76 2b |v. RESULTIS v+|
00000fa0 31 20 7d 0a 0a 41 4e 44 20 47 65 74 57 69 74 68 |1 }..AND GetWith|
00000fb0 4d 61 72 6b 28 73 69 7a 65 2c 20 6d 61 72 6b 29 |Mark(size, mark)|
00000fc0 20 3d 20 56 41 4c 4f 46 20 7b 0a 2f 2f 20 41 6c | = VALOF {.// Al|
00000fd0 6c 6f 63 61 74 65 73 20 61 20 6e 65 77 20 76 65 |locates a new ve|
00000fe0 63 74 6f 72 2c 20 61 6e 64 20 61 64 64 73 20 69 |ctor, and adds i|
00000ff0 74 20 74 6f 20 74 68 65 20 63 68 61 69 6e 20 41 |t to the chain A|
00001000 46 54 45 52 20 74 68 65 20 67 69 76 65 6e 20 6d |FTER the given m|
00001010 61 72 6b 2e 0a 20 20 20 4c 45 54 20 76 20 20 3d |ark.. LET v =|
00001020 20 47 65 74 56 65 63 74 6f 72 28 73 69 7a 65 29 | GetVector(size)|
00001030 2d 31 0a 20 20 20 4c 45 54 20 76 6d 20 3d 20 6d |-1. LET vm = m|
00001040 6b 2e 76 65 63 74 6f 72 21 6d 61 72 6b 0a 0a 20 |k.vector!mark.. |
00001050 20 20 77 6f 72 6b 56 65 63 74 6f 72 73 20 3a 3d | workVectors :=|
00001060 20 21 76 0a 20 20 20 21 76 20 3a 3d 20 21 76 6d | !v. !v := !vm|
00001070 0a 20 20 20 21 76 6d 20 3a 3d 20 76 0a 20 20 20 |. !vm := v. |
00001080 52 45 53 55 4c 54 49 53 20 76 2b 31 20 7d 0a 0a |RESULTIS v+1 }..|
00001090 41 4e 44 20 46 72 65 65 56 65 63 74 6f 72 28 76 |AND FreeVector(v|
000010a0 29 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 6c 76 |) BE {. LET lv|
000010b0 2e 63 20 3d 20 40 77 6f 72 6b 56 65 63 74 6f 72 |.c = @workVector|
000010c0 73 0a 20 20 20 76 20 3a 3d 20 76 2d 31 0a 0a 20 |s. v := v-1.. |
000010d0 20 20 57 48 49 4c 45 20 21 6c 76 2e 63 7e 3d 30 | WHILE !lv.c~=0|
000010e0 20 44 4f 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 | DO {. LET |
000010f0 76 31 20 3d 20 21 6c 76 2e 63 0a 20 20 20 20 20 |v1 = !lv.c. |
00001100 20 49 46 20 76 31 3d 76 20 54 48 45 4e 20 7b 0a | IF v1=v THEN {.|
00001110 09 20 21 6c 76 2e 63 20 3a 3d 20 21 76 31 0a 09 |. !lv.c := !v1..|
00001120 20 46 72 65 65 56 65 63 28 76 29 0a 09 20 52 45 | FreeVec(v).. RE|
00001130 54 55 52 4e 20 7d 0a 20 20 20 20 20 20 6c 76 2e |TURN }. lv.|
00001140 63 20 3a 3d 20 76 31 20 7d 0a 20 20 20 43 6f 6d |c := v1 }. Com|
00001150 70 6c 61 69 6e 28 22 42 55 47 3a 20 69 6e 76 61 |plain("BUG: inva|
00001160 6c 69 64 20 66 72 65 65 76 65 63 74 6f 72 20 63 |lid freevector c|
00001170 61 6c 6c 22 29 20 7d 0a 0a 41 4e 44 20 47 65 74 |all") }..AND Get|
00001180 42 6c 6b 28 73 69 7a 65 29 20 3d 20 56 41 4c 4f |Blk(size) = VALO|
00001190 46 20 7b 0a 20 20 20 4c 45 54 20 70 20 3d 20 3f |F {. LET p = ?|
000011a0 0a 20 20 20 49 46 20 32 3c 3d 73 69 7a 65 3c 3d |. IF 2<=size<=|
000011b0 66 72 65 65 2e 6d 61 78 20 54 48 45 4e 20 7b 0a |free.max THEN {.|
000011c0 20 20 20 20 20 20 70 20 3a 3d 20 66 72 65 65 4c | p := freeL|
000011d0 69 73 74 73 21 73 69 7a 65 3b 0a 20 20 20 20 20 |ists!size;. |
000011e0 20 49 46 20 70 7e 3d 30 20 54 48 45 4e 20 7b 0a | IF p~=0 THEN {.|
000011f0 09 20 66 72 65 65 4c 69 73 74 73 21 73 69 7a 65 |. freeLists!size|
00001200 20 3a 3d 20 21 70 3b 0a 09 20 52 45 53 55 4c 54 | := !p;.. RESULT|
00001210 49 53 20 70 20 7d 20 7d 3b 0a 0a 20 20 20 49 46 |IS p } };.. IF|
00001220 20 68 65 61 70 70 74 72 2b 73 69 7a 65 3e 68 65 | heapptr+size>he|
00001230 61 70 2e 62 6c 6f 63 6b 2e 73 69 7a 65 20 54 48 |ap.block.size TH|
00001240 45 4e 20 7b 0a 20 20 20 2f 2f 20 41 6c 6c 6f 63 |EN {. // Alloc|
00001250 61 74 65 20 27 6c 61 72 67 65 27 20 76 65 63 74 |ate 'large' vect|
00001260 6f 72 73 20 73 65 70 61 72 61 74 65 6c 79 2c 20 |ors separately, |
00001270 74 6f 20 72 65 64 75 63 65 20 66 72 61 67 6d 65 |to reduce fragme|
00001280 6e 74 61 74 69 6f 6e 2e 0a 20 20 20 20 20 20 49 |ntation.. I|
00001290 46 20 73 69 7a 65 3e 68 65 61 70 2e 62 6c 6f 63 |F size>heap.bloc|
000012a0 6b 2e 73 69 7a 65 2f 34 20 54 48 45 4e 20 52 45 |k.size/4 THEN RE|
000012b0 53 55 4c 54 49 53 20 47 65 74 56 65 63 74 6f 72 |SULTIS GetVector|
000012c0 28 73 69 7a 65 29 0a 20 20 20 20 20 20 68 65 61 |(size). hea|
000012d0 70 2e 62 6c 6f 63 6b 20 3a 3d 20 47 65 74 56 65 |p.block := GetVe|
000012e0 63 74 6f 72 28 68 65 61 70 2e 62 6c 6f 63 6b 2e |ctor(heap.block.|
000012f0 73 69 7a 65 29 0a 20 20 20 20 20 20 68 65 61 70 |size). heap|
00001300 70 74 72 20 3a 3d 20 30 20 7d 0a 0a 20 20 20 70 |ptr := 0 }.. p|
00001310 20 3a 3d 20 68 65 61 70 70 74 72 2b 68 65 61 70 | := heapptr+heap|
00001320 2e 62 6c 6f 63 6b 0a 20 20 20 68 65 61 70 70 74 |.block. heappt|
00001330 72 20 3a 3d 20 68 65 61 70 70 74 72 2b 73 69 7a |r := heapptr+siz|
00001340 65 0a 20 20 20 73 70 61 63 65 2e 75 73 65 64 20 |e. space.used |
00001350 3a 3d 20 73 70 61 63 65 2e 75 73 65 64 2b 73 69 |:= space.used+si|
00001360 7a 65 0a 20 20 20 52 45 53 55 4c 54 49 53 20 70 |ze. RESULTIS p|
00001370 20 7d 0a 0a 41 4e 44 20 4d 61 72 6b 48 65 61 70 | }..AND MarkHeap|
00001380 28 6d 61 72 6b 29 20 42 45 20 7b 0a 20 20 20 6d |(mark) BE {. m|
00001390 6b 2e 76 65 63 74 6f 72 21 6d 61 72 6b 20 3a 3d |k.vector!mark :=|
000013a0 20 77 6f 72 6b 56 65 63 74 6f 72 73 0a 20 20 20 | workVectors. |
000013b0 6d 6b 2e 62 6c 6f 63 6b 21 6d 61 72 6b 20 3a 3d |mk.block!mark :=|
000013c0 20 68 65 61 70 2e 62 6c 6f 63 6b 0a 20 20 20 6d | heap.block. m|
000013d0 6b 2e 70 74 72 21 6d 61 72 6b 20 3a 3d 20 68 65 |k.ptr!mark := he|
000013e0 61 70 70 74 72 0a 20 20 20 6d 6b 2e 75 73 65 64 |apptr. mk.used|
000013f0 21 6d 61 72 6b 20 3a 3d 20 73 70 61 63 65 2e 75 |!mark := space.u|
00001400 73 65 64 20 7d 0a 0a 41 4e 44 20 52 65 73 65 74 |sed }..AND Reset|
00001410 48 65 61 70 28 6d 61 72 6b 29 20 42 45 20 7b 0a |Heap(mark) BE {.|
00001420 20 20 20 4c 45 54 20 76 20 3d 20 6d 6b 2e 76 65 | LET v = mk.ve|
00001430 63 74 6f 72 21 6d 61 72 6b 0a 0a 20 20 20 57 48 |ctor!mark.. WH|
00001440 49 4c 45 20 77 6f 72 6b 56 65 63 74 6f 72 73 7e |ILE workVectors~|
00001450 3d 76 20 44 4f 0a 20 20 20 20 20 20 46 72 65 65 |=v DO. Free|
00001460 56 65 63 74 6f 72 28 77 6f 72 6b 56 65 63 74 6f |Vector(workVecto|
00001470 72 73 2b 31 29 3b 0a 0a 20 20 20 46 4f 52 20 69 |rs+1);.. FOR i|
00001480 20 3d 20 32 20 54 4f 20 66 72 65 65 2e 6d 61 78 | = 2 TO free.max|
00001490 20 44 4f 20 66 72 65 65 4c 69 73 74 73 21 69 20 | DO freeLists!i |
000014a0 3a 3d 20 30 3b 0a 0a 20 20 20 68 65 61 70 2e 62 |:= 0;.. heap.b|
000014b0 6c 6f 63 6b 20 3a 3d 20 6d 6b 2e 62 6c 6f 63 6b |lock := mk.block|
000014c0 21 6d 61 72 6b 0a 20 20 20 68 65 61 70 70 74 72 |!mark. heapptr|
000014d0 20 3a 3d 20 6d 6b 2e 70 74 72 21 6d 61 72 6b 0a | := mk.ptr!mark.|
000014e0 20 20 20 73 70 61 63 65 2e 75 73 65 64 20 3a 3d | space.used :=|
000014f0 20 6d 6b 2e 75 73 65 64 21 6d 61 72 6b 20 7d 0a | mk.used!mark }.|
00001500 0a 41 4e 44 20 46 72 65 65 42 6c 6b 28 70 2c 20 |.AND FreeBlk(p, |
00001510 73 69 7a 65 29 20 3d 20 56 41 4c 4f 46 20 7b 0a |size) = VALOF {.|
00001520 20 20 20 4c 45 54 20 72 65 73 20 3d 20 21 70 3b | LET res = !p;|
00001530 0a 20 20 20 54 45 53 54 20 32 3c 3d 73 69 7a 65 |. TEST 2<=size|
00001540 3c 3d 66 72 65 65 2e 6d 61 78 20 54 48 45 4e 20 |<=free.max THEN |
00001550 7b 0a 20 20 20 20 20 20 21 70 20 3a 3d 20 66 72 |{. !p := fr|
00001560 65 65 4c 69 73 74 73 21 73 69 7a 65 3b 0a 20 20 |eeLists!size;. |
00001570 20 20 20 20 66 72 65 65 4c 69 73 74 73 21 73 69 | freeLists!si|
00001580 7a 65 20 3a 3d 20 70 20 7d 0a 20 20 20 45 4c 53 |ze := p }. ELS|
00001590 45 0a 20 20 20 20 20 20 43 6f 6d 70 6c 61 69 6e |E. Complain|
000015a0 28 22 42 61 64 20 63 61 6c 6c 20 74 6f 20 46 72 |("Bad call to Fr|
000015b0 65 65 42 6c 6b 3a 20 73 69 7a 65 20 3d 20 25 6e |eeBlk: size = %n|
000015c0 22 2c 20 73 69 7a 65 29 3b 0a 20 20 20 52 45 53 |", size);. RES|
000015d0 55 4c 54 49 53 20 72 65 73 20 7d 0a 0a 41 4e 44 |ULTIS res }..AND|
000015e0 20 46 69 6c 6c 42 6c 6b 28 6e 2c 20 61 2c 20 62 | FillBlk(n, a, b|
000015f0 2c 20 63 2c 20 64 2c 20 65 2c 20 66 2c 20 67 2c |, c, d, e, f, g,|
00001600 20 68 2c 20 69 2c 20 6a 2c 20 6b 29 20 3d 20 56 | h, i, j, k) = V|
00001610 41 4c 4f 46 20 7b 0a 20 20 20 4c 45 54 20 70 20 |ALOF {. LET p |
00001620 3d 20 47 65 74 42 6c 6b 28 6e 29 3b 0a 20 20 20 |= GetBlk(n);. |
00001630 46 4f 52 20 69 20 3d 20 31 20 54 4f 20 6e 20 44 |FOR i = 1 TO n D|
00001640 4f 0a 20 20 20 20 20 20 28 69 2d 31 29 21 70 20 |O. (i-1)!p |
00001650 3a 3d 20 69 21 40 6e 3b 0a 20 20 20 52 45 53 55 |:= i!@n;. RESU|
00001660 4c 54 49 53 20 70 20 7d 0a 0a 41 4e 44 20 4f 70 |LTIS p }..AND Op|
00001670 65 6e 28 66 69 6c 65 2c 20 69 6e 70 75 74 2c 20 |en(file, input, |
00001680 62 69 6e 61 72 79 29 20 3d 20 56 41 4c 4f 46 20 |binary) = VALOF |
00001690 7b 0a 20 20 2f 2f 20 54 68 65 20 73 74 6f 72 65 |{. // The store|
000016a0 20 66 6f 72 20 74 68 65 20 73 74 72 65 61 6d 20 | for the stream |
000016b0 6f 62 6a 65 63 74 20 69 73 20 6f 62 74 61 69 6e |object is obtain|
000016c0 65 64 20 62 79 20 75 73 69 6e 67 0a 20 20 2f 2f |ed by using. //|
000016d0 20 27 67 65 74 77 69 74 68 6d 61 72 6b 27 2c 20 | 'getwithmark', |
000016e0 71 75 6f 74 69 6e 67 20 74 68 65 20 27 70 72 69 |quoting the 'pri|
000016f0 6d 61 6c 2e 6d 61 72 6b 27 2e 09 54 68 69 73 20 |mal.mark'..This |
00001700 69 73 0a 20 20 2f 2f 20 69 6d 70 6f 72 74 61 6e |is. // importan|
00001710 74 20 62 65 63 61 75 73 65 20 74 68 65 20 4f 43 |t because the OC|
00001720 4f 44 45 20 73 74 72 65 61 6d 20 6d 61 79 20 62 |ODE stream may b|
00001730 65 20 6f 70 65 6e 65 64 20 69 6e 20 74 68 65 0a |e opened in the.|
00001740 20 20 2f 2f 20 54 52 4e 20 70 68 61 73 65 2c 20 | // TRN phase, |
00001750 41 46 54 45 52 20 74 68 65 20 74 72 65 65 20 68 |AFTER the tree h|
00001760 61 73 20 62 65 65 6e 20 62 75 69 6c 74 2e 09 49 |as been built..I|
00001770 66 20 74 68 65 0a 20 20 2f 2f 20 6e 6f 72 6d 61 |f the. // norma|
00001780 6c 20 27 67 65 74 76 65 63 74 6f 72 27 20 72 6f |l 'getvector' ro|
00001790 75 74 69 6e 65 20 77 61 73 20 75 73 65 64 2c 20 |utine was used, |
000017a0 74 68 65 20 73 74 6f 72 65 20 66 6f 72 20 74 68 |the store for th|
000017b0 69 73 0a 20 20 2f 2f 20 73 74 72 65 61 6d 20 77 |is. // stream w|
000017c0 6f 75 6c 64 20 62 65 20 66 72 65 65 64 20 61 66 |ould be freed af|
000017d0 74 65 72 20 74 68 65 20 74 72 61 6e 73 6c 61 74 |ter the translat|
000017e0 69 6f 6e 20 77 61 73 0a 20 20 2f 2f 20 63 6f 6d |ion was. // com|
000017f0 70 6c 65 74 65 2e 0a 20 20 20 4c 45 54 20 73 20 |plete.. LET s |
00001800 3d 20 69 6e 70 75 74 20 2d 3e 20 46 69 6e 64 49 |= input -> FindI|
00001810 6e 70 75 74 28 66 69 6c 65 29 2c 20 46 69 6e 64 |nput(file), Find|
00001820 4f 75 74 70 75 74 28 66 69 6c 65 29 0a 20 20 20 |Output(file). |
00001830 49 46 20 73 7e 3d 30 20 54 48 45 4e 20 7b 0a 20 |IF s~=0 THEN {. |
00001840 20 20 20 20 20 4c 45 54 20 73 74 72 20 3d 20 47 | LET str = G|
00001850 65 74 57 69 74 68 4d 61 72 6b 28 73 74 2e 73 69 |etWithMark(st.si|
00001860 7a 65 2c 20 70 72 69 6d 61 6c 2e 6d 61 72 6b 29 |ze, primal.mark)|
00001870 0a 20 20 20 20 20 20 4c 45 54 20 6e 61 6d 65 20 |. LET name |
00001880 3d 20 47 65 74 57 69 74 68 4d 61 72 6b 28 28 66 |= GetWithMark((f|
00001890 69 6c 65 25 30 29 2f 42 79 74 65 73 50 65 72 57 |ile%0)/BytesPerW|
000018a0 6f 72 64 2b 31 2c 20 70 72 69 6d 61 6c 2e 6d 61 |ord+1, primal.ma|
000018b0 72 6b 29 3b 0a 20 20 20 20 20 20 46 4f 52 20 69 |rk);. FOR i|
000018c0 20 3d 20 30 20 54 4f 20 66 69 6c 65 25 30 20 44 | = 0 TO file%0 D|
000018d0 4f 20 6e 61 6d 65 25 69 20 3a 3d 20 66 69 6c 65 |O name%i := file|
000018e0 25 69 3b 0a 20 20 20 20 20 20 73 74 2e 73 74 72 |%i;. st.str|
000018f0 65 61 6d 21 73 74 72 20 3a 3d 20 73 3b 0a 20 20 |eam!str := s;. |
00001900 20 20 20 20 73 74 2e 69 6e 70 75 74 21 73 74 72 | st.input!str|
00001910 20 3a 3d 20 69 6e 70 75 74 3b 0a 20 20 20 20 20 | := input;. |
00001920 20 73 74 2e 6c 69 6e 6b 21 73 74 72 20 3a 3d 20 | st.link!str := |
00001930 73 74 72 65 61 6d 73 3b 0a 20 20 20 20 20 20 73 |streams;. s|
00001940 74 2e 66 69 6c 65 21 73 74 72 20 3a 3d 20 6e 61 |t.file!str := na|
00001950 6d 65 3b 0a 20 20 20 20 20 20 73 74 72 65 61 6d |me;. stream|
00001960 73 20 3a 3d 20 73 74 72 20 7d 0a 20 20 20 52 45 |s := str }. RE|
00001970 53 55 4c 54 49 53 20 73 20 7d 0a 0a 41 4e 44 20 |SULTIS s }..AND |
00001980 43 6c 6f 73 65 28 73 74 72 65 61 6d 29 20 42 45 |Close(stream) BE|
00001990 20 7b 0a 20 20 20 4c 45 54 20 6c 76 2e 73 74 72 | {. LET lv.str|
000019a0 20 3d 20 40 73 74 72 65 61 6d 73 0a 20 20 20 4c | = @streams. L|
000019b0 45 54 20 73 74 72 20 3d 20 73 74 72 65 61 6d 73 |ET str = streams|
000019c0 0a 0a 20 20 20 57 48 49 4c 45 20 73 74 72 7e 3d |.. WHILE str~=|
000019d0 30 20 26 20 73 74 72 65 61 6d 7e 3d 73 74 2e 73 |0 & stream~=st.s|
000019e0 74 72 65 61 6d 21 73 74 72 20 44 4f 20 7b 0a 20 |tream!str DO {. |
000019f0 20 20 20 20 20 6c 76 2e 73 74 72 20 3a 3d 20 73 | lv.str := s|
00001a00 74 2e 6c 69 6e 6b 2b 73 74 72 0a 20 20 20 20 20 |t.link+str. |
00001a10 20 73 74 72 20 3a 3d 20 21 6c 76 2e 73 74 72 20 | str := !lv.str |
00001a20 7d 0a 0a 20 20 20 49 46 20 73 74 72 3d 30 20 54 |}.. IF str=0 T|
00001a30 48 45 4e 20 43 6f 6d 70 6c 61 69 6e 28 22 42 55 |HEN Complain("BU|
00001a40 47 3a 20 62 61 64 20 63 6c 6f 73 65 20 61 72 67 |G: bad close arg|
00001a50 75 6d 65 6e 74 22 29 0a 20 20 20 21 6c 76 2e 73 |ument"). !lv.s|
00001a60 74 72 20 3a 3d 20 73 74 2e 6c 69 6e 6b 21 73 74 |tr := st.link!st|
00001a70 72 0a 0a 20 20 20 54 45 53 54 20 73 74 2e 69 6e |r.. TEST st.in|
00001a80 70 75 74 21 73 74 72 20 54 48 45 4e 20 7b 0a 20 |put!str THEN {. |
00001a90 20 20 20 20 20 4c 45 54 20 69 20 3d 20 49 6e 70 | LET i = Inp|
00001aa0 75 74 28 29 0a 20 20 20 20 20 20 53 65 6c 65 63 |ut(). Selec|
00001ab0 74 49 6e 70 75 74 28 73 74 72 65 61 6d 29 0a 20 |tInput(stream). |
00001ac0 20 20 20 20 20 45 6e 64 52 65 61 64 28 29 0a 20 | EndRead(). |
00001ad0 20 20 20 20 20 49 46 20 69 7e 3d 73 74 72 65 61 | IF i~=strea|
00001ae0 6d 20 54 48 45 4e 20 53 65 6c 65 63 74 49 6e 70 |m THEN SelectInp|
00001af0 75 74 28 69 29 20 7d 0a 20 20 20 45 4c 53 45 20 |ut(i) }. ELSE |
00001b00 7b 0a 20 20 20 20 20 20 4c 45 54 20 6f 20 3d 20 |{. LET o = |
00001b10 4f 75 74 70 75 74 28 29 3b 0a 20 20 20 20 20 20 |Output();. |
00001b20 53 65 6c 65 63 74 4f 75 74 70 75 74 28 73 74 72 |SelectOutput(str|
00001b30 65 61 6d 29 3b 0a 20 20 20 20 20 20 45 6e 64 57 |eam);. EndW|
00001b40 72 69 74 65 28 29 3b 0a 20 20 20 20 20 20 49 46 |rite();. IF|
00001b50 20 73 74 61 6d 70 46 69 6c 65 73 20 54 48 45 4e | stampFiles THEN|
00001b60 20 53 74 61 6d 70 28 73 74 2e 66 69 6c 65 21 73 | Stamp(st.file!s|
00001b70 74 72 29 3b 0a 20 20 20 20 20 20 49 46 20 6f 7e |tr);. IF o~|
00001b80 3d 73 74 72 65 61 6d 20 54 48 45 4e 20 53 65 6c |=stream THEN Sel|
00001b90 65 63 74 4f 75 74 70 75 74 28 6f 29 20 7d 0a 20 |ectOutput(o) }. |
00001ba0 20 20 46 72 65 65 56 65 63 74 6f 72 28 73 74 2e | FreeVector(st.|
00001bb0 66 69 6c 65 21 73 74 72 29 3b 0a 20 20 20 46 72 |file!str);. Fr|
00001bc0 65 65 56 65 63 74 6f 72 28 73 74 72 29 20 7d 0a |eeVector(str) }.|
00001bd0 0a 41 4e 44 20 53 74 61 6d 70 28 6e 61 6d 65 29 |.AND Stamp(name)|
00001be0 20 42 45 20 7b 0a 20 20 20 4c 45 54 20 70 61 72 | BE {. LET par|
00001bf0 61 6d 73 20 3d 20 56 45 43 20 33 3b 0a 20 20 20 |ams = VEC 3;. |
00001c00 4c 45 54 20 64 74 20 3d 20 56 45 43 20 31 3b 0a |LET dt = VEC 1;.|
00001c10 20 20 20 42 69 6e 61 72 79 54 69 6d 65 28 64 74 | BinaryTime(dt|
00001c20 29 3b 0a 20 20 20 70 61 72 61 6d 73 21 30 20 3a |);. params!0 :|
00001c30 3d 20 23 78 66 66 66 66 66 66 30 30 20 7c 20 28 |= #xffffff00 | (|
00001c40 64 74 21 31 29 0a 20 20 20 4f 53 46 69 6c 65 28 |dt!1). OSFile(|
00001c50 32 2c 20 6e 61 6d 65 2c 20 70 61 72 61 6d 73 29 |2, name, params)|
00001c60 3b 0a 20 20 20 70 61 72 61 6d 73 21 31 20 3a 3d |;. params!1 :=|
00001c70 20 64 74 21 30 3b 0a 20 20 20 4f 53 46 69 6c 65 | dt!0;. OSFile|
00001c80 28 33 2c 20 6e 61 6d 65 2c 20 70 61 72 61 6d 73 |(3, name, params|
00001c90 29 20 7d 0a 0a 41 4e 44 20 4c 6f 6f 6b 55 70 54 |) }..AND LookUpT|
00001ca0 61 67 28 73 74 72 69 6e 67 29 20 3d 20 56 41 4c |ag(string) = VAL|
00001cb0 4f 46 20 7b 0a 2f 2f 20 4c 6f 6f 6b 73 20 75 70 |OF {.// Looks up|
00001cc0 20 74 68 65 20 74 61 67 20 77 69 74 68 20 74 68 | the tag with th|
00001cd0 65 20 6e 61 6d 65 20 67 69 76 65 6e 20 62 79 20 |e name given by |
00001ce0 74 68 65 20 73 74 72 69 6e 67 2c 0a 2f 2f 20 63 |the string,.// c|
00001cf0 72 65 61 74 69 6e 67 20 61 20 6e 65 77 20 74 61 |reating a new ta|
00001d00 67 20 6f 62 6a 65 63 74 20 28 77 69 74 68 20 76 |g object (with v|
00001d10 61 6c 75 65 20 46 41 4c 53 45 29 20 69 66 20 69 |alue FALSE) if i|
00001d20 74 20 69 73 0a 2f 2f 20 6e 6f 74 20 66 6f 75 6e |t is.// not foun|
00001d30 64 2e 20 20 54 68 65 20 74 61 67 20 6f 62 6a 65 |d. The tag obje|
00001d40 63 74 20 69 73 20 72 65 74 75 72 6e 65 64 20 61 |ct is returned a|
00001d50 73 20 74 68 65 20 72 65 73 75 6c 74 2e 0a 20 20 |s the result.. |
00001d60 20 4c 45 54 20 74 20 3d 20 74 61 67 43 68 61 69 | LET t = tagChai|
00001d70 6e 0a 20 20 20 4c 45 54 20 6c 65 6e 20 3d 20 73 |n. LET len = s|
00001d80 74 72 69 6e 67 25 30 0a 0a 20 20 20 57 48 49 4c |tring%0.. WHIL|
00001d90 45 20 74 7e 3d 30 20 44 4f 20 7b 0a 20 20 20 20 |E t~=0 DO {. |
00001da0 20 20 49 46 20 43 6f 6d 70 53 74 72 69 6e 67 28 | IF CompString(|
00001db0 73 74 72 69 6e 67 2c 20 74 61 67 2e 6e 61 6d 65 |string, tag.name|
00001dc0 2b 74 29 3d 30 20 54 48 45 4e 20 52 45 53 55 4c |+t)=0 THEN RESUL|
00001dd0 54 49 53 20 74 0a 20 20 20 20 20 20 74 20 3a 3d |TIS t. t :=|
00001de0 20 74 61 67 2e 6c 69 6e 6b 21 74 20 7d 0a 0a 20 | tag.link!t }.. |
00001df0 20 20 74 20 3a 3d 20 47 65 74 42 6c 6b 28 74 61 | t := GetBlk(ta|
00001e00 67 2e 6e 61 6d 65 2b 6c 65 6e 2f 42 79 74 65 73 |g.name+len/Bytes|
00001e10 50 65 72 57 6f 72 64 2b 31 29 0a 20 20 20 74 61 |PerWord+1). ta|
00001e20 67 2e 6c 69 6e 6b 21 74 20 3a 3d 20 74 61 67 43 |g.link!t := tagC|
00001e30 68 61 69 6e 0a 20 20 20 74 61 67 43 68 61 69 6e |hain. tagChain|
00001e40 20 3a 3d 20 74 0a 20 20 20 74 61 67 2e 76 61 6c | := t. tag.val|
00001e50 75 65 21 74 20 3a 3d 20 46 41 4c 53 45 0a 0a 20 |ue!t := FALSE.. |
00001e60 20 20 46 4f 52 20 6a 20 3d 20 30 20 54 4f 20 6c | FOR j = 0 TO l|
00001e70 65 6e 20 44 4f 0a 20 20 20 20 20 20 28 74 61 67 |en DO. (tag|
00001e80 2e 6e 61 6d 65 2b 74 29 25 6a 20 3a 3d 20 73 74 |.name+t)%j := st|
00001e90 72 69 6e 67 25 6a 0a 20 20 20 52 45 53 55 4c 54 |ring%j. RESULT|
00001ea0 49 53 20 74 20 7d 0a 0a 2e 0a 0a 53 45 43 54 49 |IS t }.....SECTI|
00001eb0 4f 4e 20 22 41 72 67 73 22 0a 0a 47 45 54 20 22 |ON "Args"..GET "|
00001ec0 62 2e 48 65 61 64 65 72 22 0a 0a 4d 41 4e 49 46 |b.Header"..MANIF|
00001ed0 45 53 54 20 7b 0a 20 20 20 61 72 67 76 2e 75 70 |EST {. argv.up|
00001ee0 62 20 3d 20 33 30 30 3b 0a 0a 2f 2f 20 22 46 52 |b = 300;..// "FR|
00001ef0 4f 4d 2c 54 4f 3d 4f 42 4a 2c 4f 43 4f 44 45 2f |OM,TO=OBJ,OCODE/|
00001f00 4b 2c 4f 50 54 2f 4b 2c 56 45 52 2f 4b 2c 4c 49 |K,OPT/K,VER/K,LI|
00001f10 53 54 2f 4b 2c 48 44 52 2f 4b 2c 43 48 41 52 43 |ST/K,HDR/K,CHARC|
00001f20 4f 44 45 2f 4b 22 0a 0a 20 20 20 61 2e 66 72 6f |ODE/K".. a.fro|
00001f30 6d 20 3d 20 20 30 0a 20 20 20 61 2e 74 6f 20 3d |m = 0. a.to =|
00001f40 20 20 31 0a 20 20 20 61 2e 6f 63 6f 64 65 20 3d | 1. a.ocode =|
00001f50 20 20 32 0a 20 20 20 61 2e 6f 70 74 20 3d 20 20 | 2. a.opt = |
00001f60 33 0a 20 20 20 61 2e 76 65 72 20 3d 20 20 34 0a |3. a.ver = 4.|
00001f70 20 20 20 61 2e 6c 69 73 74 20 3d 20 35 3b 0a 20 | a.list = 5;. |
00001f80 20 20 61 2e 68 64 72 20 3d 20 20 36 0a 20 20 20 | a.hdr = 6. |
00001f90 61 2e 63 68 61 72 63 6f 64 65 20 3d 20 20 37 20 |a.charcode = 7 |
00001fa0 7d 0a 0a 4c 45 54 20 62 63 70 6c 2e 61 72 67 73 |}..LET bcpl.args|
00001fb0 28 6d 61 72 6b 29 20 3d 20 56 41 4c 4f 46 20 7b |(mark) = VALOF {|
00001fc0 0a 2f 2f 20 43 61 6c 6c 65 64 20 74 6f 20 69 6e |.// Called to in|
00001fd0 69 74 69 61 6c 69 73 65 20 74 68 65 20 77 6f 72 |itialise the wor|
00001fe0 6c 64 20 61 6e 64 20 64 65 63 6f 64 65 20 74 68 |ld and decode th|
00001ff0 65 20 61 72 67 75 6d 65 6e 74 73 0a 2f 2f 20 6f |e arguments.// o|
00002000 66 20 74 68 65 20 42 43 50 4c 20 63 6f 6d 70 69 |f the BCPL compi|
00002010 6c 65 72 2e 20 20 54 68 65 20 70 61 72 61 6d 65 |ler. The parame|
00002020 74 65 72 20 69 73 20 61 20 68 65 61 70 20 6d 61 |ter is a heap ma|
00002030 72 6b 0a 2f 2f 20 76 65 63 74 6f 72 20 77 68 69 |rk.// vector whi|
00002040 63 68 20 69 73 20 75 73 65 64 20 62 65 66 6f 72 |ch is used befor|
00002050 65 20 61 6c 6c 6f 63 61 74 69 6e 67 20 74 68 65 |e allocating the|
00002060 20 73 74 6f 72 65 20 74 68 61 74 0a 2f 2f 20 69 | store that.// i|
00002070 73 20 6e 6f 74 20 72 65 71 75 69 72 65 64 20 61 |s not required a|
00002080 66 74 65 72 20 74 68 65 20 53 59 4e 20 61 6e 64 |fter the SYN and|
00002090 20 54 52 4e 20 70 68 61 73 65 73 2e 0a 2f 2f 0a | TRN phases..//.|
000020a0 2f 2f 20 54 68 65 20 6f 72 64 65 72 20 6f 66 20 |// The order of |
000020b0 61 6c 6c 6f 63 61 74 69 6f 6e 20 6f 66 20 73 74 |allocation of st|
000020c0 6f 72 65 20 69 73 20 69 6d 70 6f 72 74 61 6e 74 |ore is important|
000020d0 2c 20 61 6e 64 20 69 73 0a 2f 2f 20 61 73 20 66 |, and is.// as f|
000020e0 6f 6c 6c 6f 77 73 3a 0a 2f 2f 0a 2f 2f 20 20 20 |ollows:.//.// |
000020f0 20 20 56 45 52 20 73 74 72 65 61 6d 0a 2f 2f 20 | VER stream.// |
00002100 20 20 20 20 4f 43 4f 44 45 20 66 69 6c 65 20 6e | OCODE file n|
00002110 61 6d 65 20 76 65 63 74 6f 72 0a 2f 2f 20 20 20 |ame vector.// |
00002120 20 20 4f 75 74 70 75 74 20 63 6f 64 65 20 73 74 | Output code st|
00002130 72 65 61 6d 0a 2f 2f 09 09 20 20 20 20 20 20 2d |ream.//.. -|
00002140 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 20 68 65 61 |------------ hea|
00002150 70 20 6d 61 72 6b 65 64 0a 2f 2f 20 20 20 20 20 |p marked.// |
00002160 4f 74 68 65 72 73 20 73 74 72 65 61 6d 73 20 61 |Others streams a|
00002170 6e 64 20 76 65 63 74 6f 72 73 0a 2f 2f 20 20 20 |nd vectors.// |
00002180 20 20 54 61 67 20 6e 61 6d 65 20 62 6c 6f 63 6b | Tag name block|
00002190 73 20 66 72 6f 6d 20 6f 70 74 69 6f 6e 20 73 74 |s from option st|
000021a0 72 69 6e 67 0a 2f 2f 0a 20 20 20 4c 45 54 20 73 |ring.//. LET s|
000021b0 73 73 73 65 74 20 3d 20 46 41 4c 53 45 0a 20 20 |ssset = FALSE. |
000021c0 20 4c 45 54 20 63 67 20 3d 20 30 0a 20 20 20 4c | LET cg = 0. L|
000021d0 45 54 20 6c 6f 67 20 3d 20 30 0a 20 20 20 4c 45 |ET log = 0. LE|
000021e0 54 20 62 69 74 73 20 3d 20 3f 0a 20 20 20 4c 45 |T bits = ?. LE|
000021f0 54 20 61 72 67 76 20 3d 20 56 45 43 20 61 72 67 |T argv = VEC arg|
00002200 76 2e 75 70 62 0a 20 20 20 4c 45 54 20 73 2e 66 |v.upb. LET s.f|
00002210 72 6f 6e 74 2e 65 6e 64 20 3d 20 22 66 72 6f 6e |ront.end = "fron|
00002220 74 20 65 6e 64 22 0a 20 20 20 41 4e 44 20 73 2e |t end". AND s.|
00002230 63 6f 64 65 2e 67 65 6e 20 3d 20 22 63 6f 64 65 |code.gen = "code|
00002240 20 67 65 6e 65 72 61 74 6f 72 22 0a 20 20 20 41 | generator". A|
00002250 4e 44 20 73 2e 6e 6f 74 2e 72 65 63 6f 67 20 3d |ND s.not.recog =|
00002260 20 22 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 64 | "not recognised|
00002270 22 0a 20 20 20 41 4e 44 20 73 2e 6e 6f 74 2e 70 |". AND s.not.p|
00002280 72 65 63 65 64 65 64 20 3d 20 22 6e 6f 74 20 70 |receded = "not p|
00002290 72 65 63 65 64 65 64 20 62 79 20 2b 20 6f 72 20 |receded by + or |
000022a0 2d 22 0a 0a 20 20 20 2f 2f 20 49 6e 69 74 69 61 |-".. // Initia|
000022b0 6c 69 73 65 20 73 74 6f 72 61 67 65 20 61 6e 64 |lise storage and|
000022c0 20 73 74 72 65 61 6d 20 64 61 74 61 3a 20 73 6f | stream data: so|
000022d0 6d 65 20 6f 66 20 74 68 65 0a 20 20 20 2f 2f 20 |me of the. // |
000022e0 69 6e 69 74 69 61 6c 69 73 61 74 69 6f 6e 20 68 |initialisation h|
000022f0 61 73 20 62 65 65 6e 20 64 6f 6e 65 20 69 6e 20 |as been done in |
00002300 74 68 65 20 27 6d 61 69 6e 27 20 70 72 6f 67 72 |the 'main' progr|
00002310 61 6d 2e 0a 0a 20 20 20 68 65 61 70 70 74 72 20 |am... heapptr |
00002320 3a 3d 20 68 65 61 70 2e 62 6c 6f 63 6b 2e 73 69 |:= heap.block.si|
00002330 7a 65 0a 20 20 20 73 70 61 63 65 2e 75 73 65 64 |ze. space.used|
00002340 20 3a 3d 20 30 0a 0a 20 20 20 66 72 65 65 4c 69 | := 0.. freeLi|
00002350 73 74 73 20 3a 3d 20 47 65 74 56 65 63 74 6f 72 |sts := GetVector|
00002360 28 66 72 65 65 2e 6d 61 78 29 2d 31 3b 0a 20 20 |(free.max)-1;. |
00002370 20 46 4f 52 20 69 20 3d 20 32 20 54 4f 20 66 72 | FOR i = 2 TO fr|
00002380 65 65 2e 6d 61 78 20 44 4f 20 66 72 65 65 4c 69 |ee.max DO freeLi|
00002390 73 74 73 21 69 20 3a 3d 20 30 3b 0a 0a 20 20 20 |sts!i := 0;.. |
000023a0 70 72 69 6d 61 6c 2e 6d 61 72 6b 20 3a 3d 20 47 |primal.mark := G|
000023b0 65 74 42 6c 6b 28 6d 6b 2e 73 69 7a 65 29 0a 20 |etBlk(mk.size). |
000023c0 20 20 4d 61 72 6b 48 65 61 70 28 70 72 69 6d 61 | MarkHeap(prima|
000023d0 6c 2e 6d 61 72 6b 29 0a 0a 20 20 20 72 63 20 3a |l.mark).. rc :|
000023e0 3d 20 30 0a 20 20 20 74 72 61 6e 73 63 68 61 72 |= 0. transchar|
000023f0 73 20 3a 3d 20 46 41 4c 53 45 0a 20 20 20 6c 69 |s := FALSE. li|
00002400 73 70 45 78 74 65 6e 73 69 6f 6e 73 20 3a 3d 20 |spExtensions := |
00002410 54 52 55 45 3b 0a 20 20 20 63 68 61 72 43 6f 64 |TRUE;. charCod|
00002420 65 20 3a 3d 20 30 0a 20 20 20 68 65 61 64 65 72 |e := 0. header|
00002430 73 20 3a 3d 20 30 0a 20 20 20 73 6f 75 72 63 65 |s := 0. source|
00002440 53 74 72 65 61 6d 2c 20 6c 69 73 74 53 74 72 65 |Stream, listStre|
00002450 61 6d 2c 20 6d 6f 64 75 6c 65 53 74 72 65 61 6d |am, moduleStream|
00002460 20 3a 3d 20 30 2c 20 30 2c 20 30 3b 0a 0a 20 20 | := 0, 0, 0;.. |
00002470 20 70 72 6f 67 72 61 6d 53 69 7a 65 20 3a 3d 20 | programSize := |
00002480 30 0a 0a 20 20 20 74 61 67 43 68 61 69 6e 20 3a |0.. tagChain :|
00002490 3d 20 30 0a 0a 20 20 20 62 61 63 6b 77 61 72 64 |= 0.. backward|
000024a0 56 65 63 73 20 3a 3d 20 46 41 4c 53 45 3b 0a 20 |Vecs := FALSE;. |
000024b0 20 20 70 72 69 6e 74 54 72 65 65 20 3a 3d 20 46 | printTree := F|
000024c0 41 4c 53 45 3b 0a 20 20 20 70 72 6f 63 4e 61 6d |ALSE;. procNam|
000024d0 65 73 2c 20 6e 61 6d 69 6e 67 20 3a 3d 20 54 52 |es, naming := TR|
000024e0 55 45 2c 20 46 41 4c 53 45 3b 0a 20 20 20 63 61 |UE, FALSE;. ca|
000024f0 6c 6c 43 6f 75 6e 74 69 6e 67 2c 20 63 6f 75 6e |llCounting, coun|
00002500 74 69 6e 67 20 3a 3d 20 46 41 4c 53 45 2c 20 46 |ting := FALSE, F|
00002510 41 4c 53 45 3b 0a 20 20 20 63 6f 6d 70 61 63 74 |ALSE;. compact|
00002520 43 6f 64 65 2c 20 41 4f 46 6f 75 74 20 3a 3d 20 |Code, AOFout := |
00002530 54 52 55 45 2c 20 46 41 4c 53 45 3b 0a 20 20 20 |TRUE, FALSE;. |
00002540 72 62 49 6e 43 61 6c 6c 73 20 3a 3d 20 54 52 55 |rbInCalls := TRU|
00002550 45 3b 0a 20 20 20 6c 69 73 70 45 78 74 65 6e 73 |E;. lispExtens|
00002560 69 6f 6e 73 20 3a 3d 20 54 52 55 45 3b 0a 20 20 |ions := TRUE;. |
00002570 20 73 74 61 6d 70 46 69 6c 65 73 20 3a 3d 20 54 | stampFiles := T|
00002580 52 55 45 3b 0a 20 20 20 43 47 44 65 62 75 67 4d |RUE;. CGDebugM|
00002590 6f 64 65 2c 20 43 47 4f 70 74 4d 6f 64 65 20 3a |ode, CGOptMode :|
000025a0 3d 20 30 2c 20 31 3b 0a 0a 20 20 20 72 65 73 74 |= 0, 1;.. rest|
000025b0 72 69 63 74 65 64 4c 61 6e 67 75 61 67 65 20 3a |rictedLanguage :|
000025c0 3d 20 46 41 4c 53 45 0a 20 20 20 65 78 74 65 6e |= FALSE. exten|
000025d0 73 69 6f 6e 2e 6c 65 76 65 6c 20 3a 3d 20 64 65 |sion.level := de|
000025e0 66 61 75 6c 74 2e 65 78 74 65 6e 73 69 6f 6e 2e |fault.extension.|
000025f0 6c 65 76 65 6c 0a 20 20 20 65 71 75 61 74 65 43 |level. equateC|
00002600 61 73 65 73 20 3a 3d 20 54 52 55 45 0a 20 20 20 |ases := TRUE. |
00002610 72 65 74 61 69 6e 4f 63 6f 64 65 20 3a 3d 20 54 |retainOcode := T|
00002620 52 55 45 0a 0a 20 20 20 73 74 6b 63 68 6b 69 6e |RUE.. stkchkin|
00002630 67 20 3a 3d 20 46 41 4c 53 45 0a 0a 20 20 20 2f |g := FALSE.. /|
00002640 2f 20 43 6f 6d 70 75 74 65 20 74 68 65 20 6d 61 |/ Compute the ma|
00002650 63 68 69 6e 65 20 64 65 70 65 6e 64 65 6e 74 20 |chine dependent |
00002660 70 61 72 61 6d 65 74 65 72 73 20 66 6f 72 20 66 |parameters for f|
00002670 69 65 6c 64 0a 20 20 20 2f 2f 20 73 65 6c 65 63 |ield. // selec|
00002680 74 6f 72 73 2e 20 20 27 62 69 74 73 77 69 64 74 |tors. 'bitswidt|
00002690 68 27 20 69 73 20 74 68 65 20 6e 75 6d 62 65 72 |h' is the number|
000026a0 20 6f 66 20 62 69 74 73 20 69 6e 20 61 0a 20 20 | of bits in a. |
000026b0 20 2f 2f 20 42 43 50 4c 20 63 65 6c 6c 20 6f 6e | // BCPL cell on|
000026c0 20 74 68 65 20 74 61 72 67 65 74 20 6d 61 63 68 | the target mach|
000026d0 69 6e 65 2e 0a 0a 20 20 20 62 69 74 73 77 69 64 |ine... bitswid|
000026e0 74 68 20 3a 3d 20 33 32 0a 20 20 20 62 69 74 73 |th := 32. bits|
000026f0 20 3a 3d 20 62 69 74 73 77 69 64 74 68 2d 31 0a | := bitswidth-1.|
00002700 20 20 20 57 48 49 4c 45 20 62 69 74 73 7e 3d 30 | WHILE bits~=0|
00002710 20 44 4f 20 7b 20 6c 6f 67 20 3a 3d 20 6c 6f 67 | DO { log := log|
00002720 2b 31 3b 20 62 69 74 73 20 3a 3d 20 62 69 74 73 |+1; bits := bits|
00002730 3e 3e 31 20 7d 0a 0a 20 20 20 73 6c 63 74 2e 73 |>>1 }.. slct.s|
00002740 69 7a 65 2e 73 68 69 66 74 20 3a 3d 20 62 69 74 |ize.shift := bit|
00002750 73 70 65 72 77 6f 72 64 2d 6c 6f 67 0a 20 20 20 |sperword-log. |
00002760 73 6c 63 74 2e 73 68 69 66 74 2e 73 68 69 66 74 |slct.shift.shift|
00002770 20 3a 3d 20 73 6c 63 74 2e 73 69 7a 65 2e 73 68 | := slct.size.sh|
00002780 69 66 74 2d 6c 6f 67 0a 20 20 20 73 6c 63 74 2e |ift-log. slct.|
00002790 6d 61 73 6b 20 3a 3d 20 28 31 3c 3c 6c 6f 67 29 |mask := (1<<log)|
000027a0 2d 31 0a 20 20 20 73 6c 63 74 2e 6d 61 78 2e 6f |-1. slct.max.o|
000027b0 66 66 73 65 74 20 3a 3d 20 28 31 3c 3c 73 6c 63 |ffset := (1<<slc|
000027c0 74 2e 73 68 69 66 74 2e 73 68 69 66 74 29 2d 31 |t.shift.shift)-1|
000027d0 0a 0a 20 20 20 49 46 20 72 64 61 72 67 73 28 22 |.. IF rdargs("|
000027e0 46 52 4f 4d 2c 54 4f 3d 4f 42 4a 2c 4f 43 4f 44 |FROM,TO=OBJ,OCOD|
000027f0 45 2f 4b 2c 4f 50 54 2f 4b 2c 56 45 52 2f 4b 2c |E/K,OPT/K,VER/K,|
00002800 4c 49 53 54 2f 4b 2c 48 44 52 2f 4b 2c 43 48 41 |LIST/K,HDR/K,CHA|
00002810 52 43 4f 44 45 2f 4b 22 2c 0a 09 20 20 20 20 20 |RCODE/K",.. |
00002820 61 72 67 76 2c 20 61 72 67 76 2e 75 70 62 29 3d |argv, argv.upb)=|
00002830 30 0a 20 20 20 20 20 20 54 48 45 4e 20 43 6f 6d |0. THEN Com|
00002840 70 6c 61 69 6e 28 22 42 61 64 20 61 72 67 73 22 |plain("Bad args"|
00002850 29 0a 0a 20 20 20 49 46 20 61 72 67 76 21 61 2e |).. IF argv!a.|
00002860 76 65 72 7e 3d 30 20 54 48 45 4e 20 7b 0a 20 20 |ver~=0 THEN {. |
00002870 20 20 20 20 76 65 72 53 74 72 65 61 6d 20 3a 3d | verStream :=|
00002880 20 4f 70 65 6e 53 74 72 65 61 6d 28 61 72 67 76 | OpenStream(argv|
00002890 21 61 2e 76 65 72 2c 20 46 41 4c 53 45 2c 20 46 |!a.ver, FALSE, F|
000028a0 41 4c 53 45 29 0a 20 20 20 20 20 20 53 65 6c 65 |ALSE). Sele|
000028b0 63 74 4f 75 74 70 75 74 28 76 65 72 53 74 72 65 |ctOutput(verStre|
000028c0 61 6d 29 20 7d 0a 0a 20 20 20 49 46 20 61 72 67 |am) }.. IF arg|
000028d0 76 21 61 2e 6c 69 73 74 7e 3d 30 20 54 48 45 4e |v!a.list~=0 THEN|
000028e0 0a 20 20 20 20 20 20 6c 69 73 74 53 74 72 65 61 |. listStrea|
000028f0 6d 20 3a 3d 20 4f 70 65 6e 53 74 72 65 61 6d 28 |m := OpenStream(|
00002900 61 72 67 76 21 61 2e 6c 69 73 74 2c 20 46 41 4c |argv!a.list, FAL|
00002910 53 45 2c 20 46 41 4c 53 45 29 3b 0a 0a 20 20 20 |SE, FALSE);.. |
00002920 57 72 69 74 65 46 28 22 41 52 4d 20 42 43 50 4c |WriteF("ARM BCPL|
00002930 20 56 65 72 73 69 6f 6e 20 25 6e 2e 25 6e 2a 4e | Version %n.%n*N|
00002940 22 2c 20 6d 61 6a 6f 72 56 65 72 73 69 6f 6e 2c |", majorVersion,|
00002950 20 6d 69 6e 6f 72 56 65 72 73 69 6f 6e 29 0a 0a | minorVersion)..|
00002960 20 20 20 49 46 20 61 72 67 76 21 61 2e 74 6f 7e | IF argv!a.to~|
00002970 3d 30 20 54 48 45 4e 0a 20 20 20 20 20 20 6d 6f |=0 THEN. mo|
00002980 64 75 6c 65 53 74 72 65 61 6d 20 3a 3d 20 4f 70 |duleStream := Op|
00002990 65 6e 53 74 72 65 61 6d 28 61 72 67 76 21 61 2e |enStream(argv!a.|
000029a0 74 6f 2c 20 46 41 4c 53 45 2c 20 54 52 55 45 29 |to, FALSE, TRUE)|
000029b0 0a 0a 20 20 20 6f 63 6f 64 65 46 69 6c 65 20 3a |.. ocodeFile :|
000029c0 3d 20 61 72 67 76 21 61 2e 6f 63 6f 64 65 0a 20 |= argv!a.ocode. |
000029d0 20 20 49 46 20 6f 63 6f 64 65 46 69 6c 65 7e 3d | IF ocodeFile~=|
000029e0 30 20 54 48 45 4e 20 6f 63 6f 64 65 46 69 6c 65 |0 THEN ocodeFile|
000029f0 20 3a 3d 20 4e 65 77 53 74 72 69 6e 67 28 6f 63 | := NewString(oc|
00002a00 6f 64 65 46 69 6c 65 29 0a 0a 20 20 20 2f 2f 20 |odeFile).. // |
00002a10 54 68 65 20 73 74 6f 72 65 20 61 6c 6c 6f 63 61 |The store alloca|
00002a20 74 65 64 20 61 62 6f 76 65 20 77 69 6c 6c 20 62 |ted above will b|
00002a30 65 20 72 65 71 75 69 72 65 64 20 66 6f 72 20 61 |e required for a|
00002a40 6c 6c 0a 20 20 20 2f 2f 20 70 68 61 73 65 73 20 |ll. // phases |
00002a50 6f 66 20 74 68 65 20 63 6f 6d 70 69 6c 65 72 3b |of the compiler;|
00002a60 20 74 68 61 74 20 77 68 69 63 68 20 69 73 20 61 | that which is a|
00002a70 6c 6c 6f 63 74 65 64 20 6e 65 78 74 0a 20 20 20 |llocted next. |
00002a80 2f 2f 20 63 61 6e 20 62 65 20 72 65 6c 65 61 73 |// can be releas|
00002a90 65 64 20 61 66 74 65 72 20 61 6c 6c 20 74 68 65 |ed after all the|
00002aa0 20 53 59 4e 20 61 6e 64 20 54 52 4e 20 70 68 61 | SYN and TRN pha|
00002ab0 73 65 73 2e 0a 20 20 20 2f 2f 20 54 68 75 73 20 |ses.. // Thus |
00002ac0 74 68 65 20 68 65 61 70 20 69 73 20 6d 61 72 6b |the heap is mark|
00002ad0 65 64 20 6e 6f 77 2e 0a 0a 20 20 20 4d 61 72 6b |ed now... Mark|
00002ae0 48 65 61 70 28 6d 61 72 6b 29 0a 0a 20 20 20 74 |Heap(mark).. t|
00002af0 61 67 2e 76 61 6c 75 65 20 21 20 4c 6f 6f 6b 75 |ag.value ! Looku|
00002b00 70 54 61 67 28 22 41 52 4d 22 29 20 3a 3d 20 54 |pTag("ARM") := T|
00002b10 52 55 45 3b 0a 0a 20 20 20 49 46 20 61 72 67 76 |RUE;.. IF argv|
00002b20 21 61 2e 63 68 61 72 63 6f 64 65 7e 3d 30 20 54 |!a.charcode~=0 T|
00002b30 48 45 4e 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 |HEN {. LET |
00002b40 73 74 72 65 61 6d 20 3d 20 4f 70 65 6e 53 74 72 |stream = OpenStr|
00002b50 65 61 6d 28 61 72 67 76 21 61 2e 63 68 61 72 63 |eam(argv!a.charc|
00002b60 6f 64 65 2c 20 54 52 55 45 2c 20 46 41 4c 53 45 |ode, TRUE, FALSE|
00002b70 29 0a 0a 20 20 20 20 20 20 63 68 61 72 43 6f 64 |).. charCod|
00002b80 65 20 3a 3d 20 47 65 74 56 65 63 74 6f 72 28 31 |e := GetVector(1|
00002b90 32 38 29 0a 20 20 20 20 20 20 74 72 61 6e 73 63 |28). transc|
00002ba0 68 61 72 73 20 3a 3d 20 54 52 55 45 0a 0a 20 20 |hars := TRUE.. |
00002bb0 20 20 20 20 53 65 6c 65 63 74 49 6e 70 75 74 28 | SelectInput(|
00002bc0 73 74 72 65 61 6d 29 0a 0a 20 20 20 20 20 20 46 |stream).. F|
00002bd0 4f 52 20 69 20 3d 20 30 20 54 4f 20 31 32 37 20 |OR i = 0 TO 127 |
00002be0 44 4f 20 63 68 61 72 43 6f 64 65 21 69 20 3a 3d |DO charCode!i :=|
00002bf0 20 52 65 61 64 43 6f 64 65 28 29 0a 20 20 20 20 | ReadCode(). |
00002c00 20 20 43 6c 6f 73 65 28 73 74 72 65 61 6d 29 0a | Close(stream).|
00002c10 20 20 20 20 20 20 49 46 20 72 63 3e 30 20 54 48 | IF rc>0 TH|
00002c20 45 4e 20 43 6f 6d 70 6c 61 69 6e 28 22 45 72 72 |EN Complain("Err|
00002c30 6f 72 20 69 6e 20 43 48 41 52 43 4f 44 45 20 74 |or in CHARCODE t|
00002c40 61 62 6c 65 22 29 20 7d 0a 0a 20 20 20 49 46 20 |able") }.. IF |
00002c50 61 72 67 76 21 61 2e 66 72 6f 6d 7e 3d 30 20 54 |argv!a.from~=0 T|
00002c60 48 45 4e 20 7b 0a 20 20 20 20 20 20 66 72 6f 6d |HEN {. from|
00002c70 66 69 6c 65 20 3a 3d 20 4e 65 77 53 74 72 69 6e |file := NewStrin|
00002c80 67 28 61 72 67 76 21 61 2e 66 72 6f 6d 29 0a 20 |g(argv!a.from). |
00002c90 20 20 20 20 20 73 6f 75 72 63 65 53 74 72 65 61 | sourceStrea|
00002ca0 6d 20 3a 3d 20 4f 70 65 6e 53 74 72 65 61 6d 28 |m := OpenStream(|
00002cb0 66 72 6f 6d 66 69 6c 65 2c 20 54 52 55 45 2c 20 |fromfile, TRUE, |
00002cc0 46 41 4c 53 45 29 20 7d 0a 0a 20 20 20 49 46 20 |FALSE) }.. IF |
00002cd0 73 6f 75 72 63 65 53 74 72 65 61 6d 3d 30 20 26 |sourceStream=0 &|
00002ce0 20 6f 63 6f 64 65 46 69 6c 65 3d 30 20 54 48 45 | ocodeFile=0 THE|
00002cf0 4e 0a 20 20 20 20 20 20 43 6f 6d 70 6c 61 69 6e |N. Complain|
00002d00 28 22 4e 6f 74 68 69 6e 67 20 74 6f 20 63 6f 6d |("Nothing to com|
00002d10 70 69 6c 65 22 29 0a 0a 20 20 20 2f 2f 20 4f 50 |pile").. // OP|
00002d20 54 20 70 61 72 61 6d 65 74 65 72 0a 20 20 20 2f |T parameter. /|
00002d30 2f 0a 20 20 20 2f 2f 20 43 6f 6d 70 69 6c 65 72 |/. // Compiler|
00002d40 20 6f 70 74 69 6f 6e 73 3a 0a 20 20 20 2f 2f 0a | options:. //.|
00002d50 20 20 20 2f 2f 09 54 20 20 20 20 20 70 72 69 6e | //.T prin|
00002d60 74 20 70 61 72 73 65 20 74 72 65 65 0a 20 20 20 |t parse tree. |
00002d70 2f 2f 09 52 20 20 20 20 20 27 72 65 73 74 72 69 |//.R 'restri|
00002d80 63 74 65 64 27 20 6c 61 6e 67 75 61 67 65 0a 20 |cted' language. |
00002d90 20 20 2f 2f 09 43 20 20 20 20 20 65 71 75 61 74 | //.C equat|
00002da0 65 20 63 61 73 65 73 0a 20 20 20 2f 2f 09 53 6e |e cases. //.Sn|
00002db0 20 20 20 20 73 65 74 20 73 61 76 65 73 70 61 63 | set savespac|
00002dc0 65 20 73 69 7a 65 0a 20 20 20 2f 2f 09 42 20 20 |e size. //.B |
00002dd0 20 20 20 73 74 61 63 6b 20 67 72 6f 77 73 20 66 | stack grows f|
00002de0 72 6f 6d 20 68 69 67 68 20 74 6f 20 6c 6f 77 20 |rom high to low |
00002df0 61 64 64 72 65 73 73 65 73 20 2d 0a 20 20 20 2f |addresses -. /|
00002e00 2f 09 20 20 20 20 20 20 70 6f 69 6e 74 20 76 65 |/. point ve|
00002e10 63 73 20 61 74 20 74 68 65 20 65 6e 64 2c 20 6e |cs at the end, n|
00002e20 6f 74 20 62 65 67 69 6e 6e 69 6e 67 0a 20 20 20 |ot beginning. |
00002e30 2f 2f 09 58 6e 20 20 20 20 73 65 74 20 65 78 74 |//.Xn set ext|
00002e40 65 6e 73 69 6f 6e 20 6c 65 76 65 6c 20 74 6f 20 |ension level to |
00002e50 6e 0a 20 20 20 2f 2f 09 24 74 61 67 20 20 73 65 |n. //.$tag se|
00002e60 74 20 74 61 67 20 74 6f 20 54 52 55 45 0a 20 20 |t tag to TRUE. |
00002e70 20 2f 2f 09 24 74 61 67 27 20 73 65 74 20 74 61 | //.$tag' set ta|
00002e80 67 20 74 6f 20 46 41 4c 53 45 0a 20 20 20 2f 2f |g to FALSE. //|
00002e90 09 44 6e 20 20 20 20 2d 20 69 67 6e 6f 72 65 64 |.Dn - ignored|
00002ea0 20 2d 0a 20 20 20 2f 2f 09 4c 6e 20 20 20 20 2d | -. //.Ln -|
00002eb0 20 69 67 6e 6f 72 65 64 20 2d 0a 20 20 20 2f 2f | ignored -. //|
00002ec0 0a 20 20 20 2f 2f 20 43 6f 64 65 20 67 65 6e 65 |. // Code gene|
00002ed0 72 61 74 6f 72 20 6f 70 74 69 6f 6e 73 3a 0a 20 |rator options:. |
00002ee0 20 20 2f 2f 0a 20 20 20 2f 2f 09 43 20 20 20 20 | //. //.C |
00002ef0 20 73 74 61 63 6b 20 63 68 65 63 6b 69 6e 67 0a | stack checking.|
00002f00 20 20 20 2f 2f 09 4e 20 20 20 20 20 70 72 6f 63 | //.N proc|
00002f10 65 64 75 72 65 20 6e 61 6d 65 73 20 69 6e 20 63 |edure names in c|
00002f20 6f 64 65 0a 20 20 20 2f 2f 09 50 20 20 20 20 20 |ode. //.P |
00002f30 70 72 6f 66 69 6c 65 20 61 6e 64 20 63 61 6c 6c |profile and call|
00002f40 20 63 6f 75 6e 74 69 6e 67 0a 20 20 20 2f 2f 09 | counting. //.|
00002f50 4b 20 20 20 20 20 63 61 6c 6c 20 63 6f 75 6e 74 |K call count|
00002f60 69 6e 67 0a 20 20 20 2f 2f 09 57 6e 20 20 20 20 |ing. //.Wn |
00002f70 2d 20 69 67 6e 6f 72 65 64 20 2d 0a 20 20 20 2f |- ignored -. /|
00002f80 2f 09 58 2d 5a 20 20 20 6d 61 63 68 69 6e 65 20 |/.X-Z machine |
00002f90 64 65 70 65 6e 64 65 6e 74 0a 20 20 20 2f 2f 0a |dependent. //.|
00002fa0 20 20 20 2f 2f 20 54 6f 20 61 6c 6c 6f 77 20 66 | // To allow f|
00002fb0 6f 72 20 74 68 65 20 24 20 28 74 61 67 20 73 65 |or the $ (tag se|
00002fc0 74 74 69 6e 67 29 20 6f 70 74 69 6f 6e 2c 20 6f |tting) option, o|
00002fd0 70 74 69 6f 6e 73 0a 20 20 20 2f 2f 20 6d 61 79 |ptions. // may|
00002fe0 20 6e 6f 77 20 62 65 20 73 65 70 61 72 61 74 65 | now be separate|
00002ff0 64 20 62 79 20 63 6f 6d 6d 61 73 2e 0a 0a 20 20 |d by commas... |
00003000 20 49 46 20 61 72 67 76 21 61 2e 6f 70 74 7e 3d | IF argv!a.opt~=|
00003010 30 20 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 53 |0 THEN {. S|
00003020 54 41 54 49 43 20 7b 20 6f 70 74 70 20 3d 20 30 |TATIC { optp = 0|
00003030 3b 20 6f 70 74 73 20 3d 20 30 20 7d 3b 0a 20 20 |; opts = 0 };. |
00003040 20 20 20 20 4c 45 54 20 66 6f 75 6e 64 20 3d 20 | LET found = |
00003050 46 41 4c 53 45 0a 20 20 20 20 20 20 4c 45 54 20 |FALSE. LET |
00003060 76 61 6c 75 65 20 3d 20 3f 0a 0a 20 20 20 20 20 |value = ?.. |
00003070 20 4c 45 54 20 72 64 6e 28 6f 70 74 63 2c 20 74 | LET rdn(optc, t|
00003080 79 70 65 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 09 |ype) = VALOF {..|
00003090 20 4c 45 54 20 6e 20 3d 20 30 0a 09 20 4c 45 54 | LET n = 0.. LET|
000030a0 20 6f 6b 20 3d 20 46 41 4c 53 45 3b 0a 09 20 57 | ok = FALSE;.. W|
000030b0 48 49 4c 45 20 6f 70 74 70 3c 6f 70 74 73 25 30 |HILE optp<opts%0|
000030c0 20 44 4f 20 7b 0a 09 20 20 20 20 4c 45 54 20 63 | DO {.. LET c|
000030d0 68 20 3d 20 6f 70 74 73 25 28 6f 70 74 70 2b 31 |h = opts%(optp+1|
000030e0 29 3b 0a 09 20 20 20 20 55 4e 4c 45 53 53 20 27 |);.. UNLESS '|
000030f0 30 27 3c 3d 63 68 3c 3d 27 39 27 20 54 48 45 4e |0'<=ch<='9' THEN|
00003100 20 42 52 45 41 4b 3b 0a 09 20 20 20 20 6f 70 74 | BREAK;.. opt|
00003110 70 20 3a 3d 20 6f 70 74 70 2b 31 3b 0a 09 20 20 |p := optp+1;.. |
00003120 20 20 6e 20 3a 3d 20 6e 2a 31 30 20 2b 20 63 68 | n := n*10 + ch|
00003130 2d 27 30 27 3b 0a 09 20 20 20 20 6f 6b 20 3a 3d |-'0';.. ok :=|
00003140 20 54 52 55 45 20 7d 3b 0a 0a 09 20 49 46 20 7e | TRUE };... IF ~|
00003150 6f 6b 20 54 48 45 4e 20 42 61 64 4f 70 74 28 6f |ok THEN BadOpt(o|
00003160 70 74 63 2c 20 74 79 70 65 2c 20 22 62 61 64 20 |ptc, type, "bad |
00003170 6e 75 6d 65 72 69 63 20 61 72 67 75 6d 65 6e 74 |numeric argument|
00003180 22 29 0a 0a 09 20 52 45 53 55 4c 54 49 53 20 6e |")... RESULTIS n|
00003190 20 7d 0a 0a 20 20 20 20 20 20 41 4e 44 20 47 65 | }.. AND Ge|
000031a0 74 54 61 67 28 29 20 42 45 20 7b 0a 20 20 20 20 |tTag() BE {. |
000031b0 20 20 2f 2f 20 43 61 6c 6c 65 64 20 61 66 74 65 | // Called afte|
000031c0 72 20 24 20 68 61 73 20 62 65 65 6e 20 66 6f 75 |r $ has been fou|
000031d0 6e 64 20 69 6e 20 74 68 65 20 66 72 6f 6e 74 20 |nd in the front |
000031e0 65 6e 64 20 6f 70 74 69 6f 6e 73 2e 0a 09 20 4c |end options... L|
000031f0 45 54 20 6c 20 3d 20 30 0a 09 20 4c 45 54 20 63 |ET l = 0.. LET c|
00003200 20 3d 20 3f 0a 09 20 4c 45 54 20 76 20 3d 20 56 | = ?.. LET v = V|
00003210 45 43 20 32 35 35 2f 42 79 74 65 73 50 65 72 57 |EC 255/BytesPerW|
00003220 6f 72 64 0a 0a 09 20 57 48 49 4c 45 20 6f 70 74 |ord... WHILE opt|
00003230 70 3c 6f 70 74 73 25 30 20 44 4f 20 7b 0a 09 20 |p<opts%0 DO {.. |
00003240 20 20 20 63 20 3a 3d 20 43 61 70 69 74 61 6c 43 | c := CapitalC|
00003250 68 28 6f 70 74 73 25 28 6f 70 74 70 2b 31 29 29 |h(opts%(optp+1))|
00003260 0a 09 20 20 20 20 49 46 20 7e 5b 27 41 27 3c 3d |.. IF ~['A'<=|
00003270 63 3c 3d 27 5a 27 20 7c 20 27 30 27 3c 3d 63 3c |c<='Z' | '0'<=c<|
00003280 3d 27 39 27 5d 20 54 48 45 4e 20 42 52 45 41 4b |='9'] THEN BREAK|
00003290 0a 09 20 20 20 20 6c 20 3a 3d 20 6c 2b 31 0a 09 |.. l := l+1..|
000032a0 20 20 20 20 6f 70 74 70 20 3a 3d 20 6f 70 74 70 | optp := optp|
000032b0 2b 31 0a 09 20 20 20 20 76 25 6c 20 3a 3d 20 63 |+1.. v%l := c|
000032c0 20 7d 0a 0a 09 20 76 25 30 20 3a 3d 20 6c 0a 09 | }... v%0 := l..|
000032d0 20 54 45 53 54 20 6c 3d 30 20 54 48 45 4e 0a 09 | TEST l=0 THEN..|
000032e0 20 20 20 20 57 72 69 74 65 53 28 22 42 61 64 20 | WriteS("Bad |
000032f0 74 61 67 20 73 65 74 74 69 6e 67 20 6f 70 74 69 |tag setting opti|
00003300 6f 6e 2a 4e 22 29 0a 09 20 45 4c 53 45 20 7b 0a |on*N").. ELSE {.|
00003310 09 20 20 20 20 4c 45 54 20 74 20 3d 20 4c 6f 6f |. LET t = Loo|
00003320 6b 55 70 54 61 67 28 76 29 0a 09 20 20 20 20 54 |kUpTag(v).. T|
00003330 45 53 54 20 63 3d 27 2a 27 27 20 54 48 45 4e 20 |EST c='*'' THEN |
00003340 7b 0a 09 20 20 20 20 20 20 20 74 61 67 2e 76 61 |{.. tag.va|
00003350 6c 75 65 21 74 20 3a 3d 20 46 41 4c 53 45 0a 09 |lue!t := FALSE..|
00003360 20 20 20 20 20 20 20 6f 70 74 70 20 3a 3d 20 6f | optp := o|
00003370 70 74 70 2b 31 20 7d 0a 09 20 20 20 20 45 4c 53 |ptp+1 }.. ELS|
00003380 45 0a 09 20 20 20 20 20 20 20 74 61 67 2e 76 61 |E.. tag.va|
00003390 6c 75 65 21 74 20 3a 3d 20 54 52 55 45 20 7d 20 |lue!t := TRUE } |
000033a0 7d 0a 0a 20 20 20 20 20 20 41 4e 44 20 42 61 64 |}.. AND Bad|
000033b0 4f 70 74 28 63 68 2c 20 73 74 61 67 65 2c 20 6d |Opt(ch, stage, m|
000033c0 65 73 73 61 67 65 29 20 42 45 0a 09 20 57 72 69 |essage) BE.. Wri|
000033d0 74 65 46 28 22 42 61 64 20 25 53 20 6f 70 74 69 |teF("Bad %S opti|
000033e0 6f 6e 20 2a 27 25 43 2a 27 20 2d 20 25 53 2a 4e |on *'%C*' - %S*N|
000033f0 22 2c 0a 09 09 20 73 74 61 67 65 2c 20 63 68 2c |",... stage, ch,|
00003400 20 6d 65 73 73 61 67 65 29 0a 0a 20 20 20 20 20 | message).. |
00003410 20 6f 70 74 73 20 3a 3d 20 61 72 67 76 21 61 2e | opts := argv!a.|
00003420 6f 70 74 3b 0a 20 20 20 20 20 20 6f 70 74 70 20 |opt;. optp |
00003430 3a 3d 20 31 3b 0a 20 20 20 20 20 20 57 48 49 4c |:= 1;. WHIL|
00003440 45 20 6f 70 74 70 3c 3d 6f 70 74 73 25 30 20 44 |E optp<=opts%0 D|
00003450 4f 20 7b 0a 09 20 4c 45 54 20 6c 76 4f 70 74 20 |O {.. LET lvOpt |
00003460 3d 20 30 0a 09 20 4c 45 54 20 63 68 20 3d 20 6f |= 0.. LET ch = o|
00003470 70 74 73 25 6f 70 74 70 0a 0a 09 20 53 57 49 54 |pts%optp... SWIT|
00003480 43 48 4f 4e 20 43 61 70 69 74 61 6c 43 68 28 63 |CHON CapitalCh(c|
00003490 68 29 20 49 4e 54 4f 20 7b 0a 09 20 20 20 20 44 |h) INTO {.. D|
000034a0 45 46 41 55 4c 54 3a 20 20 42 61 64 4f 70 74 28 |EFAULT: BadOpt(|
000034b0 63 68 2c 20 73 2e 66 72 6f 6e 74 2e 65 6e 64 2c |ch, s.front.end,|
000034c0 20 73 2e 6e 6f 74 2e 72 65 63 6f 67 29 3b 20 45 | s.not.recog); E|
000034d0 4e 44 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 |NDCASE.. CASE|
000034e0 20 27 2c 27 3a 20 45 4e 44 43 41 53 45 0a 09 20 | ',': ENDCASE.. |
000034f0 20 20 20 43 41 53 45 20 27 2b 27 3a 20 76 61 6c | CASE '+': val|
00003500 75 65 2c 20 66 6f 75 6e 64 20 3a 3d 20 54 52 55 |ue, found := TRU|
00003510 45 2c 20 54 52 55 45 3b 20 45 4e 44 43 41 53 45 |E, TRUE; ENDCASE|
00003520 0a 09 20 20 20 20 43 41 53 45 20 27 2d 27 3a 20 |.. CASE '-': |
00003530 76 61 6c 75 65 2c 20 66 6f 75 6e 64 20 3a 3d 20 |value, found := |
00003540 46 41 4c 53 45 2c 20 54 52 55 45 3b 20 45 4e 44 |FALSE, TRUE; END|
00003550 43 41 53 45 0a 0a 09 20 20 20 20 43 41 53 45 20 |CASE... CASE |
00003560 27 42 27 3a 20 6c 76 4f 70 74 20 3a 3d 20 40 62 |'B': lvOpt := @b|
00003570 61 63 6b 77 61 72 64 56 65 63 73 3b 20 45 4e 44 |ackwardVecs; END|
00003580 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 |CASE.. CASE '|
00003590 43 27 3a 20 6c 76 4f 70 74 20 3a 3d 20 40 65 71 |C': lvOpt := @eq|
000035a0 75 61 74 65 43 61 73 65 73 3b 20 45 4e 44 43 41 |uateCases; ENDCA|
000035b0 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 44 27 |SE.. CASE 'D'|
000035c0 3a 20 72 64 6e 28 63 68 2c 20 73 2e 66 72 6f 6e |: rdn(ch, s.fron|
000035d0 74 2e 65 6e 64 29 3b 20 45 4e 44 43 41 53 45 0a |t.end); ENDCASE.|
000035e0 09 20 20 20 20 43 41 53 45 20 27 48 27 3a 20 6c |. CASE 'H': l|
000035f0 76 4f 70 74 20 3a 3d 20 40 6e 61 6d 69 6e 67 3b |vOpt := @naming;|
00003600 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 41 | ENDCASE.. CA|
00003610 53 45 20 27 4c 27 3a 20 6c 76 6f 70 74 20 3a 3d |SE 'L': lvopt :=|
00003620 20 40 6c 69 73 70 45 78 74 65 6e 73 69 6f 6e 73 | @lispExtensions|
00003630 3b 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 |; ENDCASE.. C|
00003640 41 53 45 20 27 52 27 3a 20 6c 76 4f 70 74 20 3a |ASE 'R': lvOpt :|
00003650 3d 20 40 72 65 73 74 72 69 63 74 65 64 4c 61 6e |= @restrictedLan|
00003660 67 75 61 67 65 3b 20 45 4e 44 43 41 53 45 0a 09 |guage; ENDCASE..|
00003670 20 20 20 20 43 41 53 45 20 27 53 27 3a 20 73 73 | CASE 'S': ss|
00003680 73 73 65 74 20 3a 3d 20 54 52 55 45 3b 0a 09 09 |sset := TRUE;...|
00003690 20 20 20 20 20 20 73 61 76 65 73 70 61 63 65 73 | savespaces|
000036a0 69 7a 65 20 3a 3d 20 72 64 6e 28 63 68 2c 20 73 |ize := rdn(ch, s|
000036b0 2e 66 72 6f 6e 74 2e 65 6e 64 29 3b 20 45 4e 44 |.front.end); END|
000036c0 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 |CASE.. CASE '|
000036d0 54 27 3a 20 6c 76 4f 70 74 20 3a 3d 20 40 70 72 |T': lvOpt := @pr|
000036e0 69 6e 74 74 72 65 65 3b 20 45 4e 44 43 41 53 45 |inttree; ENDCASE|
000036f0 0a 09 20 20 20 20 43 41 53 45 20 27 58 27 3a 20 |.. CASE 'X': |
00003700 65 78 74 65 6e 73 69 6f 6e 2e 6c 65 76 65 6c 20 |extension.level |
00003710 3a 3d 20 72 64 6e 28 63 68 2c 20 73 2e 66 72 6f |:= rdn(ch, s.fro|
00003720 6e 74 2e 65 6e 64 29 3b 20 45 4e 44 43 41 53 45 |nt.end); ENDCASE|
00003730 0a 0a 09 20 20 20 20 43 41 53 45 20 27 24 27 3a |... CASE '$':|
00003740 20 47 65 74 54 61 67 28 29 3b 20 45 4e 44 43 41 | GetTag(); ENDCA|
00003750 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 2f 27 |SE.. CASE '/'|
00003760 3a 20 6f 70 74 70 20 3a 3d 20 6f 70 74 70 2b 31 |: optp := optp+1|
00003770 3b 20 42 52 45 41 4b 20 7d 0a 0a 09 20 6f 70 74 |; BREAK }... opt|
00003780 70 20 3a 3d 20 6f 70 74 70 2b 31 3b 0a 09 20 49 |p := optp+1;.. I|
00003790 46 20 6c 76 4f 70 74 3d 30 20 54 48 45 4e 20 4c |F lvOpt=0 THEN L|
000037a0 4f 4f 50 0a 0a 09 20 54 45 53 54 20 66 6f 75 6e |OOP... TEST foun|
000037b0 64 0a 09 20 20 20 20 54 48 45 4e 20 21 6c 76 4f |d.. THEN !lvO|
000037c0 70 74 20 3a 3d 20 76 61 6c 75 65 0a 09 20 20 20 |pt := value.. |
000037d0 20 45 4c 53 45 20 42 61 64 4f 70 74 28 63 68 2c | ELSE BadOpt(ch,|
000037e0 20 73 2e 66 72 6f 6e 74 2e 65 6e 64 2c 20 73 2e | s.front.end, s.|
000037f0 6e 6f 74 2e 70 72 65 63 65 64 65 64 29 0a 0a 09 |not.preceded)...|
00003800 20 6c 76 4f 70 74 20 3a 3d 20 30 20 7d 0a 0a 20 | lvOpt := 0 }.. |
00003810 20 20 20 20 20 2f 2f 20 43 68 65 63 6b 20 66 6f | // Check fo|
00003820 72 20 63 6f 64 65 20 67 65 6e 65 72 61 74 6f 72 |r code generator|
00003830 20 6f 70 74 69 6f 6e 73 0a 0a 20 20 20 20 20 20 | options.. |
00003840 66 6f 75 6e 64 20 3a 3d 20 46 41 4c 53 45 0a 0a |found := FALSE..|
00003850 20 20 20 20 20 20 57 48 49 4c 45 20 6f 70 74 70 | WHILE optp|
00003860 3c 3d 6f 70 74 73 25 30 20 44 4f 20 7b 0a 09 20 |<=opts%0 DO {.. |
00003870 4c 45 54 20 6c 76 4f 70 74 20 3d 20 30 0a 09 20 |LET lvOpt = 0.. |
00003880 4c 45 54 20 63 68 20 3d 20 6f 70 74 73 25 6f 70 |LET ch = opts%op|
00003890 74 70 0a 0a 09 20 53 57 49 54 43 48 4f 4e 20 43 |tp... SWITCHON C|
000038a0 61 70 69 74 61 6c 43 68 28 63 68 29 20 49 4e 54 |apitalCh(ch) INT|
000038b0 4f 20 7b 0a 09 20 20 20 20 44 45 46 41 55 4c 54 |O {.. DEFAULT|
000038c0 3a 20 20 42 61 64 4f 70 74 28 63 68 2c 20 73 2e |: BadOpt(ch, s.|
000038d0 63 6f 64 65 2e 67 65 6e 2c 20 73 2e 6e 6f 74 2e |code.gen, s.not.|
000038e0 72 65 63 6f 67 29 3b 20 45 4e 44 43 41 53 45 0a |recog); ENDCASE.|
000038f0 09 20 20 20 20 43 41 53 45 20 27 2c 27 3a 20 45 |. CASE ',': E|
00003900 4e 44 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 |NDCASE.. CASE|
00003910 20 27 2b 27 3a 20 76 61 6c 75 65 2c 20 66 6f 75 | '+': value, fou|
00003920 6e 64 20 3a 3d 20 54 52 55 45 2c 20 54 52 55 45 |nd := TRUE, TRUE|
00003930 3b 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 |; ENDCASE.. C|
00003940 41 53 45 20 27 2d 27 3a 20 76 61 6c 75 65 2c 20 |ASE '-': value, |
00003950 66 6f 75 6e 64 20 3a 3d 20 46 41 4c 53 45 2c 20 |found := FALSE, |
00003960 54 52 55 45 3b 20 45 4e 44 43 41 53 45 0a 0a 09 |TRUE; ENDCASE...|
00003970 20 20 20 20 43 41 53 45 20 27 41 27 3a 20 6c 76 | CASE 'A': lv|
00003980 4f 70 74 20 3a 3d 20 40 41 4f 46 6f 75 74 3b 20 |Opt := @AOFout; |
00003990 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 41 53 |ENDCASE.. CAS|
000039a0 45 20 27 42 27 3a 20 6c 76 6f 70 74 20 3a 3d 20 |E 'B': lvopt := |
000039b0 40 72 62 49 6e 43 61 6c 6c 73 3b 20 45 4e 44 43 |@rbInCalls; ENDC|
000039c0 41 53 45 0a 09 20 20 20 20 43 41 53 45 20 27 43 |ASE.. CASE 'C|
000039d0 27 3a 20 6c 76 4f 70 74 20 3a 3d 20 40 73 74 6b |': lvOpt := @stk|
000039e0 63 68 6b 69 6e 67 3b 20 45 4e 44 43 41 53 45 0a |chking; ENDCASE.|
000039f0 09 20 20 20 20 43 41 53 45 20 27 44 27 3a 20 43 |. CASE 'D': C|
00003a00 47 44 65 62 75 67 4d 6f 64 65 20 3a 3d 20 72 64 |GDebugMode := rd|
00003a10 6e 28 63 68 2c 20 73 2e 63 6f 64 65 2e 67 65 6e |n(ch, s.code.gen|
00003a20 29 3b 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 |); ENDCASE.. |
00003a30 43 41 53 45 20 27 4b 27 3a 20 6c 76 4f 70 74 20 |CASE 'K': lvOpt |
00003a40 3a 3d 20 40 63 61 6c 6c 63 6f 75 6e 74 69 6e 67 |:= @callcounting|
00003a50 3b 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 |; ENDCASE.. C|
00003a60 41 53 45 20 27 4e 27 3a 20 6c 76 4f 70 74 20 3a |ASE 'N': lvOpt :|
00003a70 3d 20 40 70 72 6f 63 4e 61 6d 65 73 3b 20 45 4e |= @procNames; EN|
00003a80 44 43 41 53 45 0a 09 20 20 20 20 43 41 53 45 20 |DCASE.. CASE |
00003a90 27 4f 27 3a 20 43 47 4f 70 74 4d 6f 64 65 20 3a |'O': CGOptMode :|
00003aa0 3d 20 52 64 4e 28 63 68 2c 20 73 2e 63 6f 64 65 |= RdN(ch, s.code|
00003ab0 2e 67 65 6e 29 3b 20 45 4e 44 43 41 53 45 0a 09 |.gen); ENDCASE..|
00003ac0 20 20 20 20 43 41 53 45 20 27 50 27 3a 20 6c 76 | CASE 'P': lv|
00003ad0 4f 70 74 20 3a 3d 20 40 63 6f 75 6e 74 69 6e 67 |Opt := @counting|
00003ae0 3b 20 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 |; ENDCASE.. C|
00003af0 41 53 45 20 27 53 27 3a 20 6c 76 4f 70 74 20 3a |ASE 'S': lvOpt :|
00003b00 3d 20 40 63 6f 6d 70 61 63 74 43 6f 64 65 3b 20 |= @compactCode; |
00003b10 45 4e 44 43 41 53 45 0a 09 20 20 20 20 43 41 53 |ENDCASE.. CAS|
00003b20 45 20 27 57 27 3a 20 72 64 6e 28 63 68 2c 20 73 |E 'W': rdn(ch, s|
00003b30 2e 63 6f 64 65 2e 67 65 6e 29 3b 20 45 4e 44 43 |.code.gen); ENDC|
00003b40 41 53 45 3b 0a 09 20 20 20 20 43 41 53 45 20 27 |ASE;.. CASE '|
00003b50 5a 27 3a 20 6c 76 4f 70 74 20 3a 3d 20 40 73 74 |Z': lvOpt := @st|
00003b60 61 6d 70 46 69 6c 65 73 3b 20 45 4e 44 43 41 53 |ampFiles; ENDCAS|
00003b70 45 20 7d 3b 0a 0a 09 20 6f 70 74 70 20 3a 3d 20 |E };... optp := |
00003b80 6f 70 74 70 2b 31 0a 09 20 49 46 20 6c 76 4f 70 |optp+1.. IF lvOp|
00003b90 74 3d 30 20 54 48 45 4e 20 4c 4f 4f 50 0a 0a 09 |t=0 THEN LOOP...|
00003ba0 20 54 45 53 54 20 66 6f 75 6e 64 20 54 48 45 4e | TEST found THEN|
00003bb0 0a 09 20 20 20 20 21 6c 76 4f 70 74 20 3a 3d 20 |.. !lvOpt := |
00003bc0 76 61 6c 75 65 0a 09 20 45 4c 53 45 0a 09 20 20 |value.. ELSE.. |
00003bd0 20 20 42 61 64 4f 70 74 28 63 68 2c 20 73 2e 63 | BadOpt(ch, s.c|
00003be0 6f 64 65 2e 67 65 6e 2c 20 73 2e 6e 6f 74 2e 70 |ode.gen, s.not.p|
00003bf0 72 65 63 65 64 65 64 29 0a 09 20 6c 76 4f 70 74 |receded).. lvOpt|
00003c00 20 3a 3d 20 30 20 7d 20 7d 3b 0a 0a 20 20 20 49 | := 0 } };.. I|
00003c10 46 20 6f 63 6f 64 65 46 69 6c 65 7e 3d 30 20 54 |F ocodeFile~=0 T|
00003c20 48 45 4e 20 72 65 74 61 69 6e 4f 63 6f 64 65 20 |HEN retainOcode |
00003c30 3a 3d 20 46 41 4c 53 45 3b 0a 0a 20 20 20 2f 2f |:= FALSE;.. //|
00003c40 20 48 44 52 20 70 61 72 61 6d 65 74 65 72 20 28 | HDR parameter (|
00003c50 69 66 20 72 65 61 64 20 77 69 74 68 20 2f 4c 2c |if read with /L,|
00003c60 20 74 68 65 20 6c 65 6e 67 74 68 20 69 73 20 67 | the length is g|
00003c70 69 76 65 6e 20 69 6e 20 74 68 65 20 66 69 72 73 |iven in the firs|
00003c80 74 20 77 6f 72 64 29 2e 0a 0a 20 20 20 49 46 20 |t word)... IF |
00003c90 61 72 67 76 21 61 2e 68 64 72 7e 3d 30 20 54 48 |argv!a.hdr~=0 TH|
00003ca0 45 4e 0a 20 20 20 20 20 20 68 65 61 64 65 72 73 |EN. headers|
00003cb0 20 3a 3d 20 4e 65 77 53 74 72 69 6e 67 28 61 72 | := NewString(ar|
00003cc0 67 76 21 61 2e 68 64 72 29 0a 0a 20 20 20 49 46 |gv!a.hdr).. IF|
00003cd0 20 73 6f 75 72 63 65 53 74 72 65 61 6d 7e 3d 30 | sourceStream~=0|
00003ce0 20 54 48 45 4e 20 7b 0a 20 20 20 20 20 20 53 65 | THEN {. Se|
00003cf0 6c 65 63 74 49 6e 70 75 74 28 73 6f 75 72 63 65 |lectInput(source|
00003d00 53 74 72 65 61 6d 29 0a 20 20 20 20 20 20 6c 69 |Stream). li|
00003d10 6e 65 63 6f 75 6e 74 20 3a 3d 20 31 0a 20 20 20 |necount := 1. |
00003d20 20 20 20 74 72 6e 6c 69 6e 65 63 6f 75 6e 74 20 | trnlinecount |
00003d30 3a 3d 20 31 20 7d 0a 0a 20 20 20 49 46 20 7e 73 |:= 1 }.. IF ~s|
00003d40 73 73 73 65 74 20 54 48 45 4e 20 73 61 76 65 73 |ssset THEN saves|
00003d50 70 61 63 65 73 69 7a 65 20 3a 3d 20 34 0a 0a 20 |pacesize := 4.. |
00003d60 20 20 52 45 53 55 4c 54 49 53 20 63 67 20 7d 0a | RESULTIS cg }.|
00003d70 0a 41 4e 44 20 4f 70 65 6e 53 74 72 65 61 6d 28 |.AND OpenStream(|
00003d80 66 69 6c 65 2c 20 69 6e 70 75 74 2c 20 62 69 6e |file, input, bin|
00003d90 61 72 79 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 |ary) = VALOF {. |
00003da0 20 20 4c 45 54 20 73 20 3d 20 4f 70 65 6e 28 66 | LET s = Open(f|
00003db0 69 6c 65 2c 20 69 6e 70 75 74 2c 20 62 69 6e 61 |ile, input, bina|
00003dc0 72 79 29 0a 0a 20 20 20 49 46 20 73 3d 30 20 54 |ry).. IF s=0 T|
00003dd0 48 45 4e 0a 20 20 20 20 20 41 62 61 6e 64 6f 6e |HEN. Abandon|
00003de0 28 72 65 73 75 6c 74 32 2c 20 22 43 61 6e 27 74 |(result2, "Can't|
00003df0 20 6f 70 65 6e 20 25 53 20 66 6f 72 20 25 53 70 | open %S for %Sp|
00003e00 75 74 22 2c 0a 09 20 20 20 20 20 66 69 6c 65 2c |ut",.. file,|
00003e10 20 28 69 6e 70 75 74 20 2d 3e 20 22 69 6e 22 2c | (input -> "in",|
00003e20 20 22 6f 75 74 22 29 29 0a 0a 20 20 20 52 45 53 | "out")).. RES|
00003e30 55 4c 54 49 53 20 73 20 7d 0a 0a 41 4e 44 20 4e |ULTIS s }..AND N|
00003e40 65 77 53 74 72 69 6e 67 28 73 29 20 3d 20 73 3d |ewString(s) = s=|
00003e50 30 20 2d 3e 20 30 2c 20 56 41 4c 4f 46 20 7b 0a |0 -> 0, VALOF {.|
00003e60 20 20 20 4c 45 54 20 6c 20 3d 20 73 25 30 0a 20 | LET l = s%0. |
00003e70 20 20 4c 45 54 20 76 20 3d 20 47 65 74 42 6c 6b | LET v = GetBlk|
00003e80 28 6c 20 2f 20 42 79 74 65 73 50 65 72 57 6f 72 |(l / BytesPerWor|
00003e90 64 2b 31 29 0a 20 20 20 46 4f 52 20 63 20 3d 20 |d+1). FOR c = |
00003ea0 30 20 54 4f 20 6c 20 44 4f 20 76 25 63 20 3a 3d |0 TO l DO v%c :=|
00003eb0 20 73 25 63 0a 20 20 20 52 45 53 55 4c 54 49 53 | s%c. RESULTIS|
00003ec0 20 76 20 7d 0a 0a 41 4e 44 20 52 65 61 64 43 6f | v }..AND ReadCo|
00003ed0 64 65 28 29 20 3d 20 56 41 4c 4f 46 20 7b 0a 20 |de() = VALOF {. |
00003ee0 20 2f 2f 20 55 73 65 64 20 74 6f 20 72 65 61 64 | // Used to read|
00003ef0 20 63 6f 64 65 20 76 61 6c 75 65 20 66 6f 72 20 | code value for |
00003f00 43 48 41 52 43 4f 44 45 20 70 61 72 61 6d 65 74 |CHARCODE paramet|
00003f10 65 72 2e 0a 20 20 2f 2f 0a 20 20 2f 2f 20 56 61 |er.. //. // Va|
00003f20 6c 75 65 20 6d 61 79 20 62 65 3a 20 20 20 20 6f |lue may be: o|
00003f30 6f 6f 09 20 6f 63 74 61 6c 0a 20 20 2f 2f 09 09 |oo. octal. //..|
00003f40 20 20 20 20 20 20 3a 78 78 09 20 68 65 78 0a 20 | :xx. hex. |
00003f50 20 20 4c 45 54 20 6e 20 3d 20 30 0a 20 20 20 4c | LET n = 0. L|
00003f60 45 54 20 63 68 20 3d 20 27 20 27 0a 20 20 20 4c |ET ch = ' '. L|
00003f70 45 54 20 72 78 20 3d 20 38 0a 20 20 20 4c 45 54 |ET rx = 8. LET|
00003f80 20 64 63 20 3d 20 33 0a 0a 20 20 20 57 48 49 4c | dc = 3.. WHIL|
00003f90 45 20 63 68 3d 27 2a 53 27 20 7c 20 63 68 3d 27 |E ch='*S' | ch='|
00003fa0 2a 54 27 20 7c 20 63 68 3d 27 2a 4e 27 20 44 4f |*T' | ch='*N' DO|
00003fb0 20 63 68 20 3a 3d 20 72 64 63 68 28 29 0a 0a 20 | ch := rdch().. |
00003fc0 20 20 49 46 20 63 68 3d 27 3a 27 20 54 48 45 4e | IF ch=':' THEN|
00003fd0 20 7b 0a 20 20 20 20 20 20 72 78 20 3a 3d 20 31 | {. rx := 1|
00003fe0 36 3b 20 64 63 20 3a 3d 20 20 32 3b 20 63 68 20 |6; dc := 2; ch |
00003ff0 3a 3d 20 72 64 63 68 28 29 20 7d 0a 0a 20 20 20 |:= rdch() }.. |
00004000 46 4f 52 20 69 20 3d 20 31 20 54 4f 20 64 63 20 |FOR i = 1 TO dc |
00004010 44 4f 20 7b 0a 20 20 20 20 20 20 4c 45 54 20 63 |DO {. LET c|
00004020 20 3d 20 43 61 70 69 74 61 6c 43 68 28 63 68 29 | = CapitalCh(ch)|
00004030 0a 20 20 20 20 20 20 4c 45 54 20 64 20 3d 20 27 |. LET d = '|
00004040 30 27 3c 3d 63 3c 3d 27 39 27 20 2d 3e 20 63 2d |0'<=c<='9' -> c-|
00004050 27 30 27 2c 0a 09 20 20 20 20 20 20 27 41 27 3c |'0',.. 'A'<|
00004060 3d 63 3c 3d 27 46 27 20 2d 3e 20 63 2d 27 41 27 |=c<='F' -> c-'A'|
00004070 2b 31 30 2c 20 2d 31 0a 0a 20 20 20 20 20 20 54 |+10, -1.. T|
00004080 45 53 54 20 30 3c 3d 64 3c 72 78 20 54 48 45 4e |EST 0<=d<rx THEN|
00004090 0a 09 20 6e 20 3a 3d 20 6e 2a 72 78 2b 64 0a 20 |.. n := n*rx+d. |
000040a0 20 20 20 20 20 45 4c 53 45 20 7b 0a 09 20 72 63 | ELSE {.. rc|
000040b0 20 3a 3d 20 31 30 3b 20 42 52 45 41 4b 20 7d 0a | := 10; BREAK }.|
000040c0 20 20 20 20 20 20 63 68 20 3a 3d 20 72 64 63 68 | ch := rdch|
000040d0 28 29 20 7d 0a 0a 20 20 20 49 46 20 7e 5b 63 68 |() }.. IF ~[ch|
000040e0 3d 27 2a 53 27 20 7c 20 63 68 3d 27 2a 54 27 20 |='*S' | ch='*T' |
000040f0 7c 20 63 68 3d 27 2a 4e 27 5d 20 54 48 45 4e 20 || ch='*N'] THEN |
00004100 72 63 20 3a 3d 20 31 30 0a 20 20 20 75 6e 72 64 |rc := 10. unrd|
00004110 63 68 28 29 0a 20 20 20 52 45 53 55 4c 54 49 53 |ch(). RESULTIS|
00004120 20 6e 20 7d 0a | n }.|
00004125 
.