begin; ! LC (Low-level compiler) for 8086
! Statement -> CONST {tag = cexpr}+
! {WORD, BYTE} {tag { (cexpr:cexpr) }? {= {data}+ }? }*
! SPEC tag string
! PROC tag {string}? {tag}*
! END
! tag :
! {instruction, ELSE}? {IF expr comp expr}?
! CYCLE
! FINISH
! Instruction -> MOVE {string opd, cexpr opd opd}
! JUMP tag
! REPEAT
! RETURN {expr}?
! opd = expr
! tag {expr}*
! Data -> {string, cexpr { (cexpr) }? }
! Cexpr -> const {op const}*
! Expr -> {opd, const} {op {opd, const} }*
! Opd -> tag { ( {opd, const} ) }?
! Op -> + - & ! ¬ * / % << >>
! Comp -> = # < > <= >= [ ] [= ]=
! Comments are enclosed between { and } or | and NL.
! Calling convention: Push parms, then XCALL or Push CS, CALL.
!Entry: Push DS, Push BP, Mov BP,SP, {Sub SP,framesize}?,
! {Mov AX,Glaseg, Mov DS,AX}? Xor AX,AX, Push AX
!Return: Mov SP,BP, Pop BP, Pop DS, Xret parmsize.
constinteger source=1,diag=0,object=1,list=2; !Streams
constinteger linemax=80,atommax=50,tagmax=200,textmax=20
constinteger codemax=3499,glamax=499
byteintegerarray line(1:linemax)
byteintegerarray code(0:codemax)
byteintegerarray gla(0:glamax)
integerarray atomtype,atomval(1:atommax)
integerarray tag1,tag2,tagtype,tagval(1:tagmax)
integerarray texttype,textval(1:textmax)
integer type,val,t,v,atompos,ifpos,floc,parms
integer oldapos,oldcpos,oldtpos,access,textlevel
integer lineno=0,cloc=0,gloc=0,level=0,gpos=0,cpos=0,tagpos=1
string(31)program
!Atom types
constinteger unknown=0,constant=1,string=2,label=3
constinteger var=4, wordbit=1, glabit=2, varmask=16_fc
constinteger proc=8,xproc=9,spec=10
constinteger op=11,comp=12,colon=13,sep=14,bracket=15,bx=16!wordbit
! Keyword types
constinteger kconst=17,kword=18,kbyte=19,kspec=20,kproc=21
constinteger kend=22,kmove=23,kjump=24,kreturn=25,kprogram=26
constinteger kelse=27,kfinish=28,kcycle=29,krepeat=30
!Operator codes
constinteger load=1,add=2,sub=3,and=4,or=5,xor=6,cmp=7,
mul=8,div=9,rem=10,left=11,right=12,store=13,lea=14
!Keyword tag codes (1:36 = A:Z,0:9) 1st {*37 + 2nd {*37 + 3rd}? }?
constinteger if=339
ownintegerarray n1(kconst:krepeat)=
4676, 32060, 3683, 26608, 22585, 7367, 18374, 14480, 24847, 22585,
7308, 8561, 5035, 24843
ownintegerarray n2(kconst:krepeat)=
723, 4, 5, 3, 3, 0, 5, 16, 29429, 10250,
5, 13032, 449, 6902
!Fault numbers
constinteger complex=1,atom=2,consterr=3,bfull=4,form=5,ambig=6,
nested=7,declate=8,far=9,labund=10,level0=11,varund=12,dfull=13,
repexp=14,finexp=15,context=16,maxfault=16
routine fault(integer n)
ownstring(15)array s(1:maxfault)=
"Complex",
"Atom",
"Not constant",
"Buffer full",
"Form",
"Ambiguous",
"Nesting",
"Too late",
"Too far",
"Label missing",
"Code misplaced",
"Name",
"Dict full",
"Repeat expected",
"Finish expected",
"Context"
integer i,sym
selectoutput(diag); write(lineno,1); space
i=1
cycle
sym=line(i); printsymbol(sym); i=i+1
repeatuntil sym=nl
printstring(s(n)); write(atompos-1,1); newline
selectoutput(list)
printstring("** "); printstring(s(n))
write(atompos-1,1); newline
signalevent 15
end
routine readline
owninteger semi=0
OWNINTEGER QUOTE=0
integer sym,n1,n2,radix,i,quoted,lpos
routine phex(integer x)
integer k,i
for i=12,-4,0 cycle
k=x>>i&15; k=k+7 if k>9
printsymbol(k+'0')
repeat
end
routine putatom(integer t,v)
fault(complex) if atompos>atommax
atomtype(atompos)=t; atomval(atompos)=v
atompos=atompos+1
end
selectoutput(list)
cycle
if semi=0 start
write(lineno+1,4)
printstring(" C"); phex(cloc); printstring(" D"); phex(gloc)
space
finish
lpos=1; quoted=0
cycle
next: if lpos+quoted=linemax start; ! line nearly too long: force end
if quoted=0 then sym=nl else sym=quote
else
readsymbol(sym)
finish
printsymbol(sym)
if quoted=0 start
quoted=1 if sym='''' or sym='"'
quote=sym if quoted#0
else
quoted=0 if sym=quote
finish
if quoted=0 start
if sym='{' start; ! Comment
cycle
readsymbol(sym)
printsymbol(sym)
if sym=nl start
lineno=lineno+1; spaces(18)
finish
repeatuntil sym='}'
->next
finish
sym=sym-32 if 'a'<=sym<='z'; semi=0
if sym=';' start
sym=nl; lineno=lineno-1; semi=1
finish
if sym='|' start
readsymbol(sym) and printsymbol(sym) until sym=nl
finish
finish
lineno=lineno+1 if sym=nl
line(lpos)=sym; lpos=lpos+1
repeatuntil sym=nl and quoted=0
repeatuntil lpos>2; ! non-empty line
! Now decompose line into atoms
atompos=1; ifpos=0; lpos=1
nextatom:
cycle
sym=line(lpos); lpos=lpos+1
->tag if 'A'<=sym<='Z'
->num if '0'<=sym<='9'
if sym=nl start
putatom(sep,0); atompos=1; return
finish
if sym=':' start
putatom(colon,0)
finishelseif sym='+' start
putatom(op,add)
finishelseif sym='-' start
putatom(op,sub)
finishelseif sym='&' start
putatom(op,and)
finishelseif sym='!' start
putatom(op,or)
finishelseif sym='¬' start
putatom(op,xor)
finishelseif sym='*' start
putatom(op,mul)
finishelseif sym='%' start
putatom(op,rem)
finishelseif sym='/' start
putatom(op,div)
finishelseif sym='<' or sym='>' start
if line(lpos)=sym start; ! '<<', '>>'
lpos=lpos+1
if sym='<' then putatom(op,left) else putatom(op,right)
else; ! '<', '>', '<=', '>='
square: !+'[', ']', '[=', ']='
if line(lpos)='=' start
lpos=lpos+1; sym=sym+128
finish
putatom(comp,sym)
finish
finishelseif sym='(' or sym=')' start
putatom(bracket,sym)
finishelseif sym='[' or sym=']' start
->square
finishelseif sym='=' or sym='#' start
putatom(comp,sym)
finishelseif sym='"' start
putatom(string,lpos)
lpos=lpos+1 while line(lpos)#'"'; ! we know it's there
lpos=lpos+1
finishelseif sym='''' start
sym=line(lpos); lpos=lpos+1 if sym=''''
fault(atom) if line(lpos+1)#''''
putatom(constant,sym); lpos=lpos+2
else
fault(atom) unless sym=' '
finish
repeat
num: i=0; radix=10; ! I accumulates number, default radix is ten
cycle
if sym='_' start; ! change radix
radix=i; i=0
finishelseif '9'<sym<'A' start
endconst: putatom(constant,i); lpos=lpos-1; ->nextatom
else
sym=sym-7 if sym>'9'; sym=sym-'0'
->endconst unless 0<=sym<radix
i=i*radix+sym
finish
sym=line(lpos); lpos=lpos+1
repeat
tag: n1=sym-'A'+1; n2=0; i=1; ! I counts name length
cycle
sym=line(lpos)
if 'A'<=sym<='Z' start
sym=sym-'A'+1
finishelseif '0'<=sym<='9' start
sym=sym-'0'+27
else
if n1=if start
fault(form) unless ifpos=0
ifpos=atompos; putatom(sep,0)
else; ! Look up in dictionary
for i=tagpos-1,-1,1 cycle
if tag1(i)=n1 and tag2(i)=n2 start
n1=tagtype(i); n2=tagval(i)
n2=i if n1=unknown
putatom(n1,n2)
->nextatom
finish
repeat
! Not found: enter name and details
tag1(tagpos)=n1; tag2(tagpos)=n2
tagtype(tagpos)=unknown; tagval(tagpos)=0
putatom(unknown,tagpos)
if tagpos>tagmax then fault(dfull) else tagpos=tagpos+1
finish
->nextatom
finish
if i<3 start
n1=n1*37+sym
finishelseif i<6 start
n2=n2*37+sym
finish
i=i+1; lpos=lpos+1
repeat
end
routine nextatom
type=atomtype(atompos); val=atomval(atompos)
atompos=atompos+1 unless type=sep
end
predicate open bracket
falseunless atomtype(atompos)=bracket and atomval(atompos)='('
atompos=atompos+1; true
end
routine close bracket
fault(form) unless atomtype(atompos)=bracket and atomval(atompos)=')'
atompos=atompos+1
end
predicate equal sign
falseunless atomtype(atompos)=comp and atomval(atompos)='='
atompos=atompos+1; true
end
routinespec unary
integerfn cexpr(integer must)
integer value,oper
switch s(add:right)
nextatom; unary
value=val; fault(consterr) unless type=constant
cycle
result=value unless atomtype(atompos)=op
if must=0 start
result=value unless atomtype(atompos+1)=constant
finish
oper=atomval(atompos); atompos=atompos+1
nextatom; fault(consterr) unless type=constant
->s(oper)
s(add): value=value+val; continue
s(sub): value=value-val; continue
s(and): value=value&val; continue
s(or): value=value!val; continue
s(xor): value=value!!val; continue
s(rem): value=value-value//val*val; continue
s(div): value=value//val; continue
s(mul): value=value*val; continue
s(left): value=value<<val; continue
s(right):value=value>>val
repeat
end
routine unary
integername v
returnunless type=op and atomtype(atompos)=constant
returnunless val=sub or val=xor
v==atomval(atompos)
v=¬v; v=v+1 if val=sub
val=cexpr(0); type=constant
end
routine gbyte(integer b)
fault(bfull) if gpos>glamax
gla(gpos)=b&255; gpos=gpos+1; gloc=gloc+1
end
routine gword(integer x)
gbyte(x); gbyte(x>>8)
end
routine gflush
integer i
returnif gpos=0
selectoutput(object); printsymbol(2); printsymbol(4)
printsymbol(gpos&255); printsymbol(gpos>>8&255)
printsymbol(gla(i)) for i=0,1,gpos-1
gpos=0
end
routine dumpstring(integer p)
integer l
l=0
l=l+1 and p=p+1 while line(p)#'"'
gbyte(l); p=p-l
gbyte(line(p)) and p=p+1 and l=l-1 while l>0
end
routine dump(integer byte)
fault(bfull) if cpos>codemax
code(cpos)=byte&255; cpos=cpos+1; cloc=cloc+1
end
routine flush
integer i
returnif cpos=0
selectoutput(object); printsymbol(1); printsymbol(4)
printsymbol(cpos&255); printsymbol(cpos>>8&255)
printsymbol(code(i)) for i=0,1,cpos-1
cpos=0
end
routine satrefs(integer ref,val)
integer abs,rel,disp
while ref#0 cycle
rel=ref; abs=rel-cloc+cpos; disp=val-rel-2
ref=code(abs+1)<<8+code(abs)
code(abs)=disp&255; code(abs+1)=disp>>8&255
repeat
end
routine labelref(integer type,val)
integer tvv
if type=label start
val=val-(cloc+2)
dump(val); dump(val>>8)
else
fault(form) unless type=unknown
tvv=tagval(val)
dump(tvv); dump(tvv>>8)
tagval(val)=cloc-2
finish
end
routine pushtext(integer t,v)
textlevel=textlevel+1
fault(complex) if textlevel>textmax
texttype(textlevel)=t; textval(textlevel)=v
end
routine poptext
fault(context) if textlevel=0
type=texttype(textlevel); val=textval(textlevel)
textlevel=textlevel-1
end
routinespec expr
constinteger pushax=16_50,popax=16_58
routine call(integer t,v)
type=atomtype(atompos)
if type#op start
cycle
exitif type=sep or type=comp
expr; dump(pushax); type=atomtype(atompos)
repeat
finish
if t=spec start
dump(16_FF); dump(16_1e); dump(v); dump(v>>8); !Xcall
else
dump(16_0e); dump(16_e8); labelref(label,v); !PushCs, Call
finish
end
routine immediate(integer op,val)
switch s(load:right)
->s(op)
s(load): dump(16_b8); ->imm
s(add): dump(16_05); ->imm
s(sub): dump(16_2d); ->imm
s(and): dump(16_25); ->imm
s(or): dump(16_0d); ->imm
s(xor): dump(16_35); ->imm
s(cmp): dump(16_3d)
imm: dump(val); dump(val>>8); return
s(left):
s(right):
if val=1 start
val=16_d1
else
dump(16_b1); dump(val&15); !Mov CL,nn
val=16_d3
finish
dump(val)
if op=left then dump(16_e0) else dump(16_e8)
return
s(mul):s(div):s(rem):
dump(16_b9); dump(val); dump(val>>8); !Mov CX,nn
dump(16_99) unless op=mul; !Cwd
dump(16_f7)
if op=mul then dump(16_e9) else dump(16_f9)
returnunless op=rem
dump(16_8b); dump(16_c2); !Mov ax,dx
end
routine direct(integer op,type,val,index)
ownintegerarray code(load:lea)=
16_8a, 16_02, 16_2a, 16_22, 16_0a,
16_32, 16_3a, 16_28, 16_38, 16_30,
16_e0, 16_e8, 16_88, 16_8d
integer oper,extra
immediate(op,val) andreturnif type=constant
oper=code(op)
->shift if op=left or op=right
extra=0; extra=oper and oper=16_f6 if op=mul
if op=div or op=rem start
if type&wordbit#0 then dump(16_99) else dump(16_98)
extra=oper; oper=16_f6
finish
oper=oper+1 if type&wordbit#0
dump(oper)
if type=bx then dump(16_c3+extra) andreturn
if type=unknown start
tagtype(val)=var+wordbit
tagval(val)=-2
fault(varund)
finish
fault(form) unless type&varmask=var
if type&glabit=0 start
if -128<=val<=127 then oper=16_42 else oper=16_82
oper=oper+4 if index=0
else
if index=0 start
oper=6
finishelseif -128<=val<=127 start
oper=16_44
else
oper=16_84
finish
finish
dump(oper+extra); dump(val)
dump(val>>8) if oper&16_40=0
dump(16_8B) and dump(16_C2) if op=rem
if type&wordbit=0 and op=load then dump(16_32) and dump(16_e4)
return
shift: dump(pushax)
direct(load,type,val,index); dump(16_89); dump(16_c1); !Mov Cx,Ax
dump(popax)
if type&wordbit=0 then dump(16_d2) else dump(16_d3)
dump(oper)
end
routine double(integer t); ! index for word arrays
returnif t&wordbit=0
dump(16_03); dump(16_c0); !Add ax,ax
end
routine expr
integer oper,t,v,index
oper=load
cycle
nextatom; unary
if type=constant start
atompos=atompos-1 and val=cexpr(0) if oper=load
immediate(oper,val)
finishelseif type&varmask=var start
t=type; v=val
if open bracket start
dump(pushax) unless oper=load
expr; double(t)
dump(16_8b); dump(16_f0); !Mov si,ax
dump(popax) unless oper=load
close bracket
index=1
finishelse index=0
direct(oper,t,v,index)
finishelseif type=proc or type=xproc or type=spec start
if oper=load start
call(type,val)
else
dump(pushax); call(type,val); dump(16_8b); dump(16_d8);!mov bx,ax
dump(popax); direct(oper,bx,0,0)
finish
else
fault(form)
finish
returnunless atomtype(atompos)=op
nextatom
oper=val
repeat
end
routine return
dump(16_8b); dump(16_e5); !Mov sp,bp
dump(16_5d); dump(16_1f); !Pop bp, pop ds
if parms=0 then dump(16_cb) elsestart
dump(16_ca)
dump(parms); dump(parms>>8)
finish
access=0
end
routine terminate declarations
integer i
fault(level0) if level=0
if level=1 start
level=2; i=-floc
if i>127 start
dump(16_81); dump(16_ec); dump(i); dump(i>>8); !Sub sp,nn
finishelseunless i=0 start
dump(16_83); dump(16_ec); dump(i); !sub sp,n
finish
floc=floc-2
finish
end
routine constdef
integer c
cycle
nextatom; returnif type=sep
fault(ambig) unless type=unknown; c=val
fault(form) unless equal sign
tagtype(c)=constant; tagval(c)=cexpr(1)
repeat
end
routine vardef(integer key)
integer t,lb,ub,c,r
integername v
cycle
nextatom
next: returnif type=sep
fault(ambig) unless type=unknown
t=var
t=t+wordbit if key=kword
t=t+glabit if level=0
tagtype(val)=t; v==tagval(val)
if open bracket start
lb=cexpr(1); nextatom; fault(form) unless type=colon
ub=cexpr(1)+1; close bracket
finishelse lb=0 and ub=1
lb=lb+lb and ub=ub+ub if key=kword
if level=0 start
v=gloc-lb; t=v+ub
if equal sign start
cycle
nextatom
if gloc>=t start
gflush; ->next
finish
if type=string start
dumpstring(val)
finishelseif type=sep start
readline
finishelsestart
atompos=atompos-1; c=Cexpr(1); r=1
if open bracket start
r=cexpr(1); close bracket
finish
while r>0 cycle
r=r-1; if key=kword then gword(c) else gbyte(c)
repeat
finish
repeat
else
selectoutput(object); printsymbol(2); printsymbol(3)
printsymbol(t&255); printsymbol(t>>8&255); gloc=t
finish
else
fault(declate) if level=2
floc=floc-ub+lb; v=floc-lb
finish
repeat
end
routine procdef(integer key)
integer p,sym
string(31)s
routine getstring
s=""
cycle
sym=line(val); returnif sym='"'; val=val+1; s=s.tostring(sym)
repeat
end
nextatom; fault(ambig) unless type=unknown
if key=kspec start
tagtype(val)=spec; tagval(val)=gloc
nextatom; fault(form) unless type=string
getstring; p=length(s)
selectoutput(object); printsymbol(2)
printsymbol(8); printsymbol(p); printstring(s)
printsymbol(7); printsymbol(0)
gloc=gloc+4; return
finish
fault(nested) unless level=0; level=1; access=1; textlevel=0
v=val; t=proc; nextatom
if type=string start
getstring
selectoutput(object); printsymbol(1); printsymbol(6)
printsymbol(length(s)); printstring(s)
t=xproc; nextatom
finish
tagtype(v)=t; tagval(v)=cloc
dump(16_1e); dump(16_55); !Push ds, push bp
dump(16_8b); dump(16_ec); !Mov BP,SP
dump(16_33); dump(16_C0); !Xor AX,AX
dump(pushax); !For event mechanism
if t=xproc start
fault(labund) if program=""
dump(16_b8); flush; !Mov ax,nn=dseg
printsymbol(7); printsymbol(length(program)); printstring(program)
cloc=cloc+2; dump(16_8E); dump(16_D8); !Mov ds,ax
finish
parms=0; oldtpos=v+1
while type#sep cycle
fault(ambig) unless type=unknown
tagtype(val)=var+wordbit
parms=parms+1; nextatom
repeat
p=tagpos-parms; parms=parms+parms; sym=parms+6
while p<tagpos cycle
tagval(p)=sym; sym=sym-2; p=p+1
repeat
floc=0
end
routine instruction
integer t,v,i,oper,st,sv,si,dt,dv
nextatom
if type=kmove start
nextatom; oper=16_a4; !Movb
if type=string start
st=var+glabit; sv=gloc; si=0
dumpstring(val); val=gloc-sv; gflush
if val&1=0 start
val=val>>1; oper=16_a5; !Movw
finish
immediate(load,val); dump(pushax)
else
expr; dump(pushax)
nextatom; st=type; sv=val; si=0
fault(form) unless st&varmask=var
if openbracket start
expr; double(st); si=1; dump(pushax)
closebracket
finish
oper=16_a5 if st&wordbit#0; !Movw
finish
nextatom; dt=type; dv=val
fault(form) unless dt&varmask=var
if openbracket start
expr; double(dt); dump(16_8b); dump(16_f8); !Mov di,ax
direct(lea,dt,dv,0); dump(16_03); dump(16_f8); !add di,ax
closebracket
else
direct(lea,dt,dv,0); dump(16_8b); dump(16_f8); !Mov di,ax
finish
direct(lea,st,sv,0); dump(16_8b); dump(16_f0); !Mov si,ax
if si#0 Start
dump(popax); dump(16_03); dump(16_f0); !add,si,ax
finish
if dt&glabit=0 then dump(16_16) else dump(16_1e); !Push SS/DS
dump(16_07); !Pop ES
if st&glabit=0 start
dump(16_1e); dump(16_16); dump(16_1f); !Push DS,SS, Pop DS
finish
dump(16_59); dump(16_F2); dump(oper); !Pop cx, rep
dump(16_1f) if st&glabit=0; !Pop DS
finishelseif type=krepeat start
poptext; fault(type) unless type=repexp
dump(16_E9); labelref(label,val)
finishelseif type=kjump start
nextatom; dump(16_e9); labelref(type,val)
finishelseif type=kreturn start
expr unless atomtype(atompos)=sep
return
finishelseif type&varmask=var start
t=type; v=val; i=0
if open bracket start
expr; double(t); dump(pushax)
close bracket
i=1
finish
fault(form) unless equal sign
expr; dump(16_5e) unless i=0; !pop si
direct(store,t,v,i)
finishelseif type=proc or type=xproc or type=spec start
call(type,val)
else
atompos=atompos-1
finish
end
integerfn cond; !Evaluate condition, return value of jump opcode
expr; nextatom; fault(form) unless type=comp
v=val; nextatom; unary
if atomtype(atompos)#sep or (type#constant and type&varmask#var) start
dump(pushax); atompos=atompos-1; expr
dump(16_8B); dump(16_D8); dump(popax); !Mov bx,ax
type=bx
finish
direct(cmp,type,val,0)
result=16_72 if v=']'+128
result=16_73 if v='['
result=16_74 if v='#'
result=16_75 if v='='
result=16_76 if v=']'
result=16_77 if v='['+128
result=16_7c if v='>'+128
result=16_7d if v='<'
result=16_7e if v='>'
result=16_7f; ! %if v='<'+128
end
! Main Program
onevent 15 start
finish
if tagpos=1 start; ! (not via event: first time)
program = cliparam
openinput(source,program.".lc")
openoutput(object,program.".iob")
openoutput(list,program.".lis")
selectoutput(list)
printstring(" LC Cross-compiler 06/01/81"); newline; newline
for type=kconst,1,krepeat cycle
tag1(tagpos)=n1(type); tag2(tagpos)=n2(type)
tagtype(tagpos)=type; tagval(tagpos)=-1
tagpos=tagpos+1
repeat
selectinput(source); program=""
finish
cycle
readline
cycle; !Deal with labels
nextatom
exitunless type=unknown and atomtype(atompos)=colon
tagtype(val)=label; satrefs(tagval(val),cloc)
tagval(val)=cloc; atompos=atompos+1
access=1
repeat
continueif type=sep and ifpos=0
if type=kconst start
constdef
finishelseif type=kbyte or type=kword start
vardef(type)
finishelseif type=kspec or type=kproc start
procdef(type)
finishelseif type=kend start
exitif level=0; level=0
return unless access=0; flush
val=oldtpos; oldtpos=tagpos; tagpos=val; ! Reset tagpos before moaning
while oldtpos>tagpos cycle
oldtpos=oldtpos-1; fault(labund) if tagtype(oldtpos)=unknown
repeat
unless textlevel=0 start
poptext; textlevel=0; fault(type)
finish
finishelseif type=kprogram start
fault(ambig) unless program=""
nextatom; fault(form) unless type=string
fault(form) if val='"'; !Null name not allowed
v=line(val)
cycle
val=val+1; program=program.tostring(v); v=line(val)
repeatuntil v='"'
program=program."_" unless charno(program,length(program))='_'
selectoutput(object); printsymbol(2); printsymbol(6)
printsymbol(length(program)); printstring(program)
finishelseif type=kcycle start
pushtext(repexp,cloc)
finishelseif type=kelse start
poptext; fault(type) unless type=finexp
satrefs(val,cloc+3)
poptext; fault(type) unless type=finexp
dump(16_e9); dump(val); dump(val>>8)
if ifpos=0 start
pushtext(context,0)
else
pushtext(finexp,cloc-2)
atompos=ifpos+1; dump(cond!!1); dump(3)
dump(16_E9); dump(0); dump(0)
atompos=ifpos and fault(form) unless ifpos=2
IFPOS=0
finish
pushtext(finexp,cloc-2)
finishelseif type=kfinish start
poptext; fault(type) unless type=finexp or type=context
satrefs(val,cloc)
poptext; satrefs(val,cloc); access=1
else
fault(varund) if type=unknown
terminate declarations
if ifpos=0 start; ! Statement
atompos=atompos-1; instruction
finishelseif type=sep start; ! IF condition
fault(form) unless ifpos=atompos
atompos=ifpos+1
dump(cond!!1); dump(3); dump(16_E9); dump(0); dump(0)
pushtext(finexp,0); pushtext(finexp,cloc-2)
else; ! Statement IF condition
oldapos=atompos-1; atompos=ifpos+1
dump(cond)
oldcpos=cpos; dump(0)
atompos=oldapos; instruction
v=cpos-oldcpos-1; fault(far) if v>127
code(oldcpos)=v
access=1
finish
ifpos=0
finish
nextatom; fault(form) unless type=sep and ifpos=0
repeat
selectoutput(object); printsymbol(10)
selectoutput(list); newline
endofprogram