begin ; ! Bridging (old-system) -> (new-system) command interpreter
ownstring (63)title="CLI version 02/04/85"
recordformat dictf(integer beg,pos,lim,alt)
recordformat eventfm(integer event,(integer sub or integer subevent),
integer extra,pc,string (255) message,integerarray r(0:15))
@16_1000 shortinteger linenum
@16_1100 routine etherwrite(integer port,bytename buf,integer length)
@16_1104 integerfn etherread(integer port,bytename buf,integer max)
@16_1108 integerfn fcomm(integer cn,string (255)s)
@16_117c integerfn defname(string (255)s,record (dictf)name d,integer size)
@16_1180 integerfn refname(string (255)s,record (dictf)name d)
@16_1184 routine transname(integer tag,string (255)name s)
@16_1188 routine define event handler
@16_1190 routine phex2(integer x)
@16_1194 routine phex4(integer x)
@16_1198 routine phex(integer x)
@16_3400 record (eventfm)event
@16_35c4 shortinteger userno
@16_3652 shortinteger terminalmode
@16_372c byteinteger cylock
@16_372d byteinteger fsport
@16_3f98 integer mainprogram,mexglob
@16_3fac integer cliparamad
@16_3fb0 record (dictf)comdict,fildict,extdict,sysdict
@16_3ff0 integer freebot,freetop,membot,memtop
constinteger esc=27
owninteger trouble,tmode,bottom
predicate starts(string (*)name s,integer c)
falseif length(s)=0
falseunless charno(s,1)=c
true
end
string (255)fn substring(string (255) s, integer from,to)
string (255) t
t = ""
from = 1 if from<=0
to = length(s) if to>length(s)
while from <= to cycle
t = t.tostring(charno(s,from)); from = from+1
repeat
result = t
end
predicate started(string (*)name s,integer c)
falseunless starts(s,c)
s = substring(s,2,length(s))
true
end
routine truncate(string (*)name s,integer c)
while started(s,c) cycle
repeat
end
predicate resolves(string (*)name var,fore,
string (255)match,string (*)name aft)
integer i
integerfn INDEX(string (*)name var,match)
!Return index position of first occurrence of match within string
integer i=0,j,l
l=length(match)
cycle
result = 0 if i > length(var)-l
i = i+1
j = 0
cycle
result = i if j = l
j = j+1
repeat until charno(var,i+j-1) # charno(match,j)
repeat
end
routine do aft
aft = substring(var,i+length(match),length(var)) if addr(aft) # 0
end
i = index(var,match)
false if i = 0
if addr(fore) # 0 start
if addr(fore) # addr(var) start
fore = substring(var,1,i-1)
do aft
finish else start
do aft
length(var) = i-1
finish
finish else do aft
true
end
!Aux (%signal does not work)
routine signal(integer e,s,i,string (255)m)
event_message = m
event_extra = i
e = e&15+(s&255)<<4
*move.l e,d0
*jsr 16_1114
end
routine standardise(string (*)name s)
bytename k
integer i
for i = 1,1,length(s) cycle
k == charno(s,i)
k = k&95 if 'A'<=k&95<='Z'
repeat
end
routine lock
cylock = cylock+1
end
routine unlock
returnif cylock=0
cylock = cylock-1
cylock = 0 and signal 0,1 if cylock=128
end
{%endoflist
control 16_8000
routine diagnose; !Print event message, line number, etc
!%switch main(0:15)
integer e,s,x,i
shortintegername ac,ir,sr
! %routine escapes(%string(255)s)
! %integer i
! %for i = 1,1,length(s) %cycle
! printsymbol(esc); printsymbol(charno(s,i))
! %repeat
! %end
routine symbol(integer x)
if ' '<=x<=126 start
printsymbol('''') if '0'<=x<='9'
printsymbol(x)
printsymbol('''') if '0'<=x<='9'
finishelse write(x,0)
end
e = event_event&15
s = event_subevent
x = event_extra
returnif e=0 and s=0; !normal %stop
selectinput(0); resetinput; closeinput
returnif e=0 and s=1; !^Y
newline
! escapes("G3xlXkjb"); !Reset V200
printstring("** ")
! ->main(e)
!main(0):
! %if s>>1<<1=2 %start
! %if s=2 %then printstring("Bus") %else printstring("Address")
! ac == shortinteger(addr(event_message)+2)
! ir == shortinteger(addr(event_message)+4)
! sr == shortinteger(addr(event_message)+6)
! event_r(0) = integer(addr(event_message)+8)
! printstring(" error, Code="); phex4(ac)
! printstring(", Addr="); phex(x)
! printstring(", IR="); phex4(ir)
! printstring(", SR="); phex4(sr); newline
! space %and phex(event_r(i)) %for i=0,1,7; newline
! space %and phex(event_r(i)) %for i=8,1,15
! ->norest
! %finish
! %if s=4 %start
! printstring("Illegal Instruction"); ->norest
! %finish
! %if s=5 %start
! printstring("Reserved Exception"); ->norest
! %finish
! %if s=8 %start
! printstring("Privilege violation"); ->norest
! %finish
! %if s=9 %start
! %if x=16_11bc %start
! printstring("Attempt to load FE00 externals")
! %else
! printstring("Attempt to call FE00 extracode at ")
! phex4(x)
! %finish
! newline; ->norest
! %finish
! ->unknown
!main(1):
! %if s=4 %start
! printstring("Division by zero"); ->rest
! %finish
! %if s=1 %start
! printstring("Integer ")
! %elseif s=2
! printstring("Real ")
! %elseif s=3
! printstring("String ")
! %finish
! printstring("Overflow")
! ->rest
!main(2):
! %if s=1 %start
! printstring("Not enough store")
! %elseif s=2
! printstring("Output exceeded")
! %elseif s=3
! printstring("Time limit exceeded")
! %finishelse -> unknown
! ->rest
!main(3):
! %if s=1 %start
! printstring("Transmission error")
! %elseif s=2
! printstring("Timeout")
! %elseif s=3
! printstring("Open failure")
! %elseif s=4
! printstring("I/O error")
! %finishelse ->unknown
! ->rest
!main(4):
! printstring("Non-numeric character "); symbol(x)
! printstring(" in data"); ->norest
!main(5):
! printstring("Invalid ")
! %if s=1 %start
! printstring("%for loop arguments")
! %elseif s=2
! printstring("exponent")
! %elseif s=3
! printstring("array bounds")
! %elseif s=4
! printstring("SUBSTRING arguments")
! %elseif s=5
! printstring("type")
! %else
! printstring(" arguments")
! %finish
! ->rest
!main(6):
! %if s=1 %start
! printstring("Value")
! %elseif s=2
! printstring("Array index")
! %elseif s=3
! printstring("Switch index")
! %elseif s=4
! printstring("Event number")
! %elseif s=5
! printstring("CHARNO index")
! %elseif s=6
! printstring("TOSTRING parameter")
! %elseif s=7
! printstring("Stream number")
! %finish
! write(x,1); printstring(" out of range"); ->norest
!main(7):
! printstring("String resolution fails"); ->rest
!main(8):
! printstring("Unassigned variable"); ->rest
!main(9):
! printstring("End of file reached"); ->rest
!main(10):main(11):main(12):main(13):main(14):main(15):unknown:
printstring("Event "); write(e,0); space; write(s,0)
rest:
space and write(x,0) unless x=0
somerest:
space and printstring(event_message) unless event_message=""
norest:
newline; printstring("Stopped at")
if linenum#0 start
printstring(" line "); write(linenum,0)
finish
if linenum=0 or e=0 start
printstring(" PC "); phex(event_pc)
finish
newline
end
routine close all ins
integer i=4
onevent 9 start
finish
cycle
i = i-1; selectinput(i)
returnif i=0; closeinput
repeat
end
routine close all outs
integer i=4
onevent 9 start
finish
cycle
i=i-1; selectoutput(i)
returnif i=0; closeoutput
repeat
end
routine uclose all outs
integer i=4
onevent 9 start
finish
cycle
i = i-1; exitif i=0
openoutput(i,"")
repeat
selectoutput(0)
end
{%list
control 16_8000
integerfn allocate(integer amount)
amount = (amount+3)>>2<<2
result = 0 if bottom+amount+1000>freetop
bottom = bottom+amount
result = bottom-amount
end
routine loadfile(string (255)n,integername s,l)
string (255)z
integer x,y,dict
integer pos=1,blocks,pad
integerfn hex
integer n=0,k
cycle
result = n if pos>=length(z); pos = pos+1
k = charno(z,pos-1)-'0'
result = n if k<0
n = n<<4+k
repeat
end
standardise(n)
dict = refname(n,fildict)
if dict>0 start {If entry exists
x = integer(dict); y = integer(dict+4)
if x<y start {if file remembered
s = x; l = y-x; return
finish
finish
s = 0; l = 0
z = "Z".tostring('0'+userno).n.tostring(nl) {Read file into store
lock
etherwrite(fsport,charno(z,1),length(z))
length(z) = etherread(fsport,charno(z,1),255)
unlock
if charno(z,1)='-' start
x = charno(z,2)-'0'; y =length(z)
y = y-1 if charno(z,y)=nl {and it ought to be}
n = "Load ".n
n = n." fails:"
z = substring(z,3,y)
z = n.z
signal(3,3,x,z)
finish
blocks = hex; pad = hex
x = blocks<<9-pad
y = allocate(x)
if y<=0 start
y = bottom
lock
cycle
x = etherread(fsport,byteinteger(y),512)
repeatuntil x#512
unlock
signal(2,1,l,"No space for ".n)
finish
s = y; l = x
lock
cycle
x = etherread(fsport,byteinteger(y),512)
y = y+x
repeatuntil x#512
unlock
if dict>0 start
if integer(dict)=integer(dict+4)=-1 start {marked for remembering
integer(dict) = s; integer(dict+4) = s+l
freebot = bottom
finish
finish
end
routine define symbol(string (255)symbol,value)
integer stag,vtag
standardise(symbol)
stag = defname(symbol,comdict,8)
if stag=0 start
printstring("*Command dict full"); newline; return
finish
vtag = defname(value,fildict,8)
if vtag=0 start
printstring("*File dict full"); newline; return
finish
if stag<0 start
stag = stag<<1>>1
! printstring(symbol.": ".value." replaces ")
! transname(integer(stag),symbol); printstring(symbol); newline
finish
integer(stag) = vtag<<1>>1
end
control 16_8000
routine run program(string (255)file,parm)
recordformat mex header f(short magic,flags,export,import,
integer code,short reset,main,integer own,stack,spare1,spare2)
record (mexheaderf)name h
bytename first,second
integer start,limit
routine run(integer xpc,xd6)
integer env
onevent 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 start
*move.l env,a6
set terminal mode(tmode)
if event_event!event_subevent=0 c
then close all outs elsestart
uclose all outs
selectinput(0); resetinput; closeinput
finish
close all ins; diagnose; return
finish
tmode = terminalmode
*move.l a6,env
linenum = 0
*move.l xpc,a0
*move.l xd6,d6
*jsr (a0)
stop
end
cliparamad = addr(parm)
bottom = freebot
loadfile(file,start,limit); limit = limit+start
first == byteinteger(start)
second == byteinteger(start+1)
unless first=16_fe start
printstring("File ".file." starts with ")
phex2(first); printstring(" instead of FE")
newline; return
finish
while started(parm,' ') cycle ; repeat
parm = tostring(255) if parm=""
prompt(":"); selectinput(0); selectoutput(0)
mainprogram = 0
if 1<=second<=3 start ; !Mex format
mainprogram = start
loadfile("fmac:mexrun.mob",start,limit); limit = limit+start
parm = "" if parm = tostring(255)
h == record(start)
start = start+32+h_export
if h_import!h_own#0 c
or shortinteger(start+h_reset<<1)#16_4e75 start
printstring("File fmac:mexrun.mob is not as expected"); newline; return
finish
run(start+h_main<<1,(bottom+3+256)&¬3)
else
printstring("Warning: ".file." starts with FE"); phex2(second); newline
run(limit-4,(bottom+3+256)&¬3)
finish
end
control 16_8000
routinespec obeystream(string (255)parms)
routine obeyfile(string (255)verb,parms)
onevent 3,4,9 start
printstring(event_message); newline
return
finish
openinput(1,verb) {Test whether file accessible}
selectinput(0); closeinput
openinput(0,verb)
selectinput(1); closeinput
selectinput(0)
obeystream(parms)
end
predicate verify
string (255)x
integer tag
tag = refname("VERIFY",comdict)
falseif tag<=0
tag = integer(tag)
transname(tag,x)
tag = length(x)
falseif tag=0
tag = charno(x,tag)&1
falseif tag=0
true
end
routine obeyline(string (255)line)
@0string (1)null
string (255)verb,param,spare
integer tag,pos,sym,lives=9
constintegerarray bit(0:3) = 0,
{ ?>=<;:9876543210/.-,+*)('&%$#"!
2_01010111111111110100111111111100,
2_11111111111111111111111111111111,
2_01111111111111111111111111111111
onevent 2,3,4,9 start
printstring(event_message); newline
return
finish
!First parse the line, split it up into verb and parameters.
!Then perform verb translation.
truncate(line,' '); truncate(line,'{'); truncate(line,' ')
if started(line,'@') start
truncate(line,' ')
line = "@".line
finish
cycle
verb = ""
pos = 1
cycle
exitif pos>length(line); sym = charno(line,pos)
exitif bit(sym>>5&3)&1<<(sym&31)=0
verb = verb.tostring(sym); pos = pos+1
repeat
returnif verb=""
!! sym = '=' %and pos = pos+1 %if sym='_' {suppress symbol translation}
if charno(verb,length(verb))='_' start
sym = '='; length(verb) = length(verb)-1
finish
param = substring(line,pos,length(line))
exitif sym='='
standardise(verb)
tag = refname(verb,comdict)
exitif tag<=0
tag = integer(tag)
transname(tag,verb)
line = verb.param
lives = lives-1
if lives=0 start
printstring("Symbol translation looping: ".line); newline
verb = ""; return
finish
repeat
if verify start
printstring(verb)
printstring(param)
newline
finish
!Now decide whether the command is a symbol definition or
!a request to run a program or a request to obey another file.
if length(param)>1 and charno(param,1)='=' start
definesymbol(verb,substring(param,2,length(param)))
elseif starts(verb,'@')
verb = substring(verb,2,length(verb))
verb = verb.".COM" unless resolves(verb,null,".",null)
obeyfile(verb,param)
else
verb = verb.".MOB" unless resolves(verb,null,".",null)
runprogram(verb,param)
finish
end
routine obeystream(string (255)parms)
string (63)array parameter(1:8)
string (255)parm,rest,line
integer i
integerfn nsym
integer k
k = nextsymbol&127
k = nl if k<' '
result = k
end
integerfn rsym
integer k,x
x = nsym
readsymbol(k); result = x unless k=esc
readsymbol(k); result = x unless k='?'
readsymbol(k); result = x
end
predicate fits(integer n)
trueif length(line)+n<=255
false
end
routine read line
string (63)p
integer k,kk,i
selectinput(0)
prompt("} ")
cycle
cycle
line = ""
cycle
k = rsym; exitif k=nl
if k='%' and '1'<=nsym<='8' start
k = rsym; p = parameter(k-'0')
if fits(length(p)) start
line = line.p
else
line = line."%" if fits(1)
line = line.tostring(k) if fits(1)
finish
elseif k='-' and nsym=nl
k=rsym
else
line = line.tostring(k) if fits(1)
finish
repeat
exitunless started(line,'!')
continueunless starts(line,'!')
kk = 0
for i = 2,1,length(line) cycle
k = charno(line,i); kk = k unless k=' '
printsymbol(k)
repeat
newline unless kk=':'
repeat
repeatuntil line#""
end
onevent 0,9 start
resetinput; closeinput
return
finish
parms = parm." ".rest while resolves(parms,parm," ",rest)
parms = rest while resolves(parms,parm," ",rest) and parm=""
parms = parm.",".rest while resolves(parms,parm," ",rest)
parms = parm.",".rest while resolves(parms,parm,"/",rest)
parms = parms.","
for i = 1,1,8 cycle
parm = "" unless resolves(parms,parm,",",parms)
parameter(i) = parm
repeat
cycle
readline
obeyline(line)
repeat
end
!%routine load imp runtime support
!%integer d
! d = defname("I:LIB.MOB",fildict,8)
! integer(d) = -1; integer(d+4) = -1
! obeyline("i:lib")
! obeyline("fmac:floating")
!%end
{%endoflist
control 16_8000
integerfn handle event; ! Unwind stack frames until event trap is found
constinteger bsr=16_6100,jsrel=16_4eba,bra=16_6000,link=16_4e50
constinteger jmpabslong=16_4ef9,moveltoa6=16_2c7c
constinteger jsra6=16_4eae,jsrabsshort=16_4eb8,jsrabslong=16_4eb9
integer frame,bit
integer retad,entry,eventbeg,eventend,temp,olda6
integername a4,a5,a6,fp,sp
predicate ok(integer lo,hi); ! False unless accessible
falseunless lo<=hi and lo&1=0
trueif membot<=lo and hi<memtop
trueif 0<=lo and hi<16_4000
false
end
! %returnif event_event=9 %and event_subevent=3 %and event_extra=0;!FShangup
! A4 and A5 are assumed to be used as base registers. Their values
! are interpreted as stack frame pointers established using the
! LINK instruction, but only if they point into the stack at an
! even address. The lower of A4 and A5 is selected as pointing to
! the most recent stack frame. It is assumed to point at a pair
! (Old Frame Pointer, Return Address). The return address is used
! to find the BSR instruction which called the current procedure,
! thereby locating its entry-point. As confirmation, the first
! instruction of the thus located procedure is verified to be a
! LINK instruction with the appropriate register number. The word
! preceeding the entry point is taken to be the event mask, bit i
! being set if event i is trapped at this level. The word
! preceeding that is taken to be the relative displacement of the
! (start of the) event block. The trap is ignored if the event was
! signalled from within that event block, so we need to know where
! the end is. We assume that the event block is preceeded by a BRA
! instruction to just past the event block.
bit=1<<event_event
a4 == event_r(12); a5 == event_r(13); a6 == event_r(14); sp == event_r(15)
cycle
cycle
frame = 0; fp == sp
frame = 5 and fp == a5 if ok(a5,a5+7) and sp<=a5
frame = 4 and fp == a4 if ok(a4,a4+7) and sp<=a4 c
and (frame=0 or a4<fp)
result =1 if frame=0
retad = integer(fp+4)
olda6 = a6
result =2 unless ok(retad-6,retad-1)
if shortinteger(retad-4)=bsr start
entry = shortinteger(retad-2)+retad-2
elseif shortinteger(retad-4)=jsrel
entry = shortinteger(retad-2)+retad-2
elseif shortinteger(retad-4)=jsrabsshort
entry = shortinteger(retad-2)
elseif shortinteger(retad-4)=jsra6
result =3 unless ok(fp+8,fp+11)
a6 = integer(fp+8)
temp = a6+shortinteger(retad-2)
result =4 unless ok(temp,temp+11)
result =5 unless shortinteger(temp)=moveltoa6 c
and shortinteger(temp+6)=jmpabslong
result =6 unless integer(temp+2)=olda6
entry = integer(temp+8)
elseif shortinteger(retad-6)=jsrabslong
entry = integer(retad-4)
finishelseresult =7
cycle
result =8 unless ok(entry-4,entry+3)
temp = shortinteger(entry)
if temp=bra start
entry = shortinteger(entry+2)+entry+2
elseif temp=jmpabslong
entry = integer(entry+2)
finishelseexit ; ! Not stepping stone ->
repeat
result =9 unless temp=link+frame
exitif shortinteger(entry-2)&bit#0; ! Trap found ->
sp = fp+8; fp = integer(fp); ! Simulate UNLK, RTS
repeat
eventbeg = shortinteger(entry-4)+entry-4
result =10 unless ok(eventbeg-4,eventbeg-1)
result =11 unless shortinteger(eventbeg-4)=bra
eventend = shortinteger(eventbeg-2)+eventbeg-2
result =12 unless ok(eventbeg,eventend-1)
a6 = olda6 andexitunless eventbeg<event_pc<=eventend
sp = fp+8; fp = integer(fp)
repeat
sp = fp+shortinteger(entry+2); !simulate link
event_r(8) = eventbeg
temp = addr(event_r(0))
*move.l temp,a0
*movem.l (a0),#16_ffff
*jmp (a0)
end
{%list
mexglob = 0
cylock = 0
event_event = -1
define event handler
unless event_event=-1 start
trouble = handle event; !Returns only if trouble
selectoutput(0)
set terminal mode(tmode)
printstring("*Trouble("); write(trouble,0); printstring("):")
uclose all outs; close all ins
selectinput(0); resetinput; closeinput
selectoutput(0); diagnose
*sub.l #2048,sp
cycle
obeyfile(":t","")
repeat
finish
event_event = 0
*sub.l #2048,sp
printstring(title); newline
bottom = freebot
!load imp runtime support
obeyfile("fmac:astartup.com","")
cycle
obeyfile(":t","")
repeat
endofprogram