em.p 54 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768
  1. #
  2. { This is an interpreter for EM. It serves as a specification for the
  3. EM machine. This interpreter must run on a machine which supports
  4. arithmetic with words and memory offsets.
  5. Certain aspects are over specified. In particular:
  6. 1. The representation of an address on the stack need not be the
  7. numerical value of the memory location.
  8. 2. The state of the stack is not defined after a trap has aborted
  9. an instruction in the middle. For example, it is officially un-
  10. defined whether the second operand of an ADD instruction has
  11. been popped or not if the first one is undefined ( -32768 or
  12. unsigned 32768).
  13. 3. The memory layout is implementation dependent. Only the most
  14. basic checks are performed whenever memory is accessed.
  15. 4. The representation of an integer or set on the stack is not fixed
  16. in bit order.
  17. 5. The format and existence of the procedure descriptors depends on
  18. the implementation.
  19. 6. The result of the compare operators CMI etc. are -1, 0 and 1
  20. here, but other negative and positive values will do and they
  21. need not be the same each time.
  22. 7. The shift count for SHL, SHR, ROL and ROR must be in the range 0
  23. to object size in bits - 1. The effect of a count not in this
  24. range is undefined.
  25. 8. This interpreter does not work for double word integers, although
  26. any decent EM implementation will include double word arithmetic.
  27. }
  28. {$i256}
  29. {$d+}
  30. #ifndef DOC
  31. program em(tables,prog,core,input,output);
  32. #else
  33. program em(tables,prog,input,output);
  34. #endif
  35. label 8888,9999;
  36. const
  37. t15 = 32768; { 2**15 }
  38. t15m1 = 32767; { 2**15 -1 }
  39. t16 = 65536; { 2**16 }
  40. t16m1 = 65535; { 2**16 -1 }
  41. t31m1 = 2147483647; { 2**31 -1 }
  42. { constants indicating the size of words and addresses }
  43. wsize = 2; { number of bytes in a word }
  44. asize = 2; { number of bytes in an address }
  45. fsize = 4; { number of bytes in a floating point number }
  46. maxret =4; { number of words in the return value area }
  47. signbit = t15; { the power of two indicating the sign bit }
  48. negoff = t16; { the next power of two }
  49. maxsint = t15m1; { the maximum signed integer }
  50. maxuint = t16m1; { the maximum unsigned integer }
  51. maxdbl = t31m1; { the maximum double signed integer }
  52. maxadr = t16m1; { the maximum address }
  53. maxoffs = t15m1; { the maximum offset from an address }
  54. maxbitnr= 15; { the number of the highest bit }
  55. lineadr = 0; { address of the line number }
  56. fileadr = 4; { address of the file name }
  57. maxcode = 8191; { highest byte in code address space }
  58. maxdata = 8191; { highest byte in data address space }
  59. { format of status save area }
  60. statd = 4; { how far is static link from lb }
  61. dynd = 2; { how far is dynamic link from lb }
  62. reta = 0; { how far is the return address from lb }
  63. savsize = 4; { size of save area in bytes }
  64. { procedure descriptor format }
  65. pdlocs = 0; { offset for size of local variables in bytes }
  66. pdbase = asize; { offset for the procedure base }
  67. pdsize = 4; { size of procedure descriptor in bytes = 2*asize }
  68. { header words }
  69. NTEXT = 1;
  70. NDATA = 2;
  71. NPROC = 3;
  72. ENTRY = 4;
  73. NLINE = 5;
  74. SZDATA = 6;
  75. escape1 = 254; { escape to secondary opcodes }
  76. escape2 = 255; { escape to tertiary opcodes }
  77. undef = signbit; { the range of integers is -32767 to +32767 }
  78. { error codes }
  79. EARRAY = 0; ERANGE = 1; ESET = 2; EIOVFL = 3;
  80. EFOVFL = 4; EFUNFL = 5; EIDIVZ = 6; EFDIVZ = 7;
  81. EIUND = 8; EFUND = 9; ECONV = 10; ESTACK = 16;
  82. EHEAP = 17; EILLINS = 18; EODDZ = 19; ECASE = 20;
  83. EMEMFLT = 21; EBADPTR = 22; EBADPC = 23; EBADLAE = 24;
  84. EBADMON = 25; EBADLIN = 26; EBADGTO = 27;
  85. {
  86. .ne 20
  87. .bp
  88. ----------------------------------------------------------------------------}
  89. { Declarations }
  90. {---------------------------------------------------------------------------}
  91. type
  92. bitval= 0..1; { one bit }
  93. bitnr= 0..maxbitnr; { bits in machine words are numbered 0 to 15 }
  94. byte= 0..255; { memory is an array of bytes }
  95. adr= {0..maxadr} long; { the range of addresses }
  96. word= {0..maxuint} long;{ the range of unsigned integers }
  97. offs= -maxoffs..maxoffs; { the range of signed offsets from addresses }
  98. size= 0..maxoffs; { the range of sizes is the positive offsets }
  99. sword= {-signbit..maxsint} long; { the range of signed integers }
  100. full= {-maxuint..maxuint} long; { intermediate results need this range }
  101. double={-maxdbl..maxdbl} long; { double precision range }
  102. bftype= (andf,iorf,xorf); { tells which boolean operator needed }
  103. insclass=(prim,second,tert); { tells which opcode table is in use }
  104. instype=(implic,explic); { does opcode have implicit or explicit operand }
  105. iflags= (mini,short,sbit,wbit,zbit,ibit);
  106. ifset= set of iflags;
  107. mnem = ( NON,
  108. AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ,
  109. BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL,
  110. CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS,
  111. CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE,
  112. DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL,
  113. GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC,
  114. LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE,
  115. LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF,
  116. MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU,
  117. ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF,
  118. SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE,
  119. STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT,
  120. TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE,
  121. ZRE, ZRF, ZRL);
  122. dispatch = record
  123. iflag: ifset;
  124. instr: mnem;
  125. case instype of
  126. implic: (implicit:sword);
  127. explic: (ilength:byte);
  128. end;
  129. var
  130. code: packed array[0..maxcode] of byte; { code space }
  131. data: packed array[0..maxdata] of byte; { data space }
  132. retarea: array[1..maxret ] of word; { return area }
  133. pc,lb,sp,hp,pd: adr; { internal machine registers }
  134. i: integer; { integer scratch variable }
  135. s,t :word; { scratch variables }
  136. sz:size; { scratch variables }
  137. ss,st: sword; { scratch variables }
  138. k :double; { scratch variables }
  139. j:size; { scratch variable used as index }
  140. a,b:adr; { scratch variable used for addresses }
  141. dt,ds:double; { scratch variables for double precision }
  142. rt,rs,x,y:real; { scratch variables for real }
  143. found:boolean; { scratch }
  144. opcode: byte; { holds the opcode during execution }
  145. iclass: insclass; { true for escaped opcodes }
  146. dispat: array[insclass,byte] of dispatch;
  147. retsize:size; { holds size of last LFR }
  148. insr: mnem; { holds the instruction number }
  149. halted: boolean; { normally false }
  150. exitstatus:word; { parameter of MON 1 }
  151. ignmask:word; { ignore mask for traps }
  152. uerrorproc:adr; { number of user defined error procedure }
  153. intrap:boolean; { Set when executing trap(), to catch recursive calls}
  154. trapval:byte; { Set to number of last trap }
  155. header: array[1..8] of adr;
  156. tables: text; { description of EM instructions }
  157. prog: file of byte; { program and initialized data }
  158. #ifndef DOC
  159. core: file of byte; { post mortem dump }
  160. #endif
  161. {
  162. .ne 20
  163. .sp 5
  164. {---------------------------------------------------------------------------}
  165. { Various check routines }
  166. {---------------------------------------------------------------------------}
  167. { Only the most basic checks are performed. These routines are inherently
  168. implementation dependent. }
  169. procedure trap(n:byte); forward;
  170. #ifndef DOC
  171. procedure writecore(n:byte); forward;
  172. #endif
  173. procedure memadr(a:adr);
  174. begin if (a>maxdata) or ((a<sp) and (a>=hp)) then trap(EMEMFLT) end;
  175. procedure wordadr(a:adr);
  176. begin memadr(a); if (a mod wsize<>0) then trap(EBADPTR) end;
  177. procedure chkadr(a:adr; s:size);
  178. begin memadr(a); memadr(a+s-1); { assumption: size is ok }
  179. if s<wsize
  180. then begin if a mod s<>0 then trap(EBADPTR) end
  181. else if a mod wsize<>0 then trap(EBADPTR)
  182. end;
  183. procedure newpc(a:double);
  184. begin if (a<0) or (a>maxcode) then trap(EBADPC); pc:=a end;
  185. procedure newsp(a:adr);
  186. begin if (a>lb) or (a<hp) or (a mod wsize<>0) then trap(ESTACK); sp:=a end;
  187. procedure newlb(a:adr);
  188. begin if (a<sp) or (a mod wsize<>0) then trap(ESTACK); lb:=a end;
  189. procedure newhp(a:adr);
  190. begin if (a>sp) or (a>maxdata+1) or (a mod wsize<>0)
  191. then trap(EHEAP)
  192. else hp:=a
  193. end;
  194. function argc(a:double):sword;
  195. begin if (a<-signbit) or (a>maxsint) then trap(EILLINS); argc:=a end;
  196. function argd(a:double):double;
  197. begin if (a<-maxdbl) or (a>maxdbl) then trap(EILLINS); argd:=a end;
  198. function argl(a:double):offs;
  199. begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argl:=a end;
  200. function argg(k:double):adr;
  201. begin if (k<0) or (k>maxadr) then trap(EILLINS); argg:=k end;
  202. function argf(a:double):offs;
  203. begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argf:=a end;
  204. function argn(a:double):word;
  205. begin if (a<0) or (a>maxuint) then trap(EILLINS); argn:=a end;
  206. function args(a:double):size;
  207. begin if (a<=0) or (a>maxoffs)
  208. then trap(EODDZ)
  209. else if (a mod wsize)<>0 then trap(EODDZ);
  210. args:=a ;
  211. end;
  212. function argz(a:double):size;
  213. begin if (a<0) or (a>maxoffs)
  214. then trap(EODDZ)
  215. else if (a mod wsize)<>0 then trap(EODDZ);
  216. argz:=a ;
  217. end;
  218. function argo(a:double):size;
  219. begin if (a<=0) or (a>maxoffs)
  220. then trap(EODDZ)
  221. else if (a mod wsize<>0) and (wsize mod a<>0) then trap(EODDZ);
  222. argo:=a ;
  223. end;
  224. function argw(a:double):size;
  225. begin if (a<=0) or (a>maxoffs) or (a>maxuint)
  226. then trap(EODDZ)
  227. else if (a mod wsize)<>0 then trap(EODDZ);
  228. argw:=a ;
  229. end;
  230. function argp(a:double):size;
  231. begin if (a<0) or (a>=header[NPROC]) then trap(EILLINS); argp:=a end;
  232. function argr(a:double):word;
  233. begin if (a<0) or (a>2) then trap(EILLINS); argr:=a end;
  234. procedure argwf(s:double);
  235. begin if argw(s)<>fsize then trap(EILLINS) end;
  236. function szindex(s:double):integer;
  237. begin s:=argw(s); if (s mod wsize <> 0) or (s>2*wsize) then trap(EILLINS);
  238. szindex:=s div wsize
  239. end;
  240. function locadr(l:double):adr;
  241. begin l:=argl(l); if l<0 then locadr:=lb+l else locadr:=lb+l+savsize end;
  242. function signwd(w:word):sword;
  243. begin if w = undef then trap(EIUND);
  244. if w >= signbit then signwd:=w-negoff else signwd:=w
  245. end;
  246. function dosign(w:word):sword;
  247. begin if w >= signbit then dosign:=w-negoff else dosign:=w end;
  248. function unsign(w:sword):word;
  249. begin if w<0 then unsign:=w+negoff else unsign:=w end;
  250. function chopw(dw:double):word;
  251. begin chopw:=dw mod negoff end;
  252. function fitsw(w:full;trapno:byte):word;
  253. { checks whether value fits in signed word, returns unsigned representation}
  254. begin
  255. if (w>maxsint) or (w<-signbit) then
  256. begin trap(trapno);
  257. if w<0 then fitsw:=negoff- (-w)mod negoff
  258. else fitsw:=w mod negoff;
  259. end
  260. else fitsw:=unsign(w)
  261. end;
  262. function fitd(w:full):double;
  263. begin
  264. if abs(w) > maxdbl then trap(ECONV);
  265. fitd:=w
  266. end;
  267. {
  268. .ne 20
  269. .sp 5
  270. {---------------------------------------------------------------------------}
  271. { Memory access routines }
  272. {---------------------------------------------------------------------------}
  273. { memw returns a machine word as an unsigned integer
  274. memb returns a single byte as a positive integer: 0 <= memb <= 255
  275. mems(a,s) fetches an object smaller than a word and returns a word
  276. store(a,v) stores the word v at machine address a
  277. storea(a,v) stores the address v at machine address a
  278. storeb(a,b) stores the byte b at machine address a
  279. stores(a,s,v) stores the s least significant bytes of a word at address a
  280. memi returns an offset from the instruction space
  281. Note that the procedure descriptors are part of instruction space.
  282. nextpc returns the next byte addressed by pc, incrementing pc
  283. lino changes the line number word.
  284. filna changes the pointer to the file name.
  285. All routines check to make sure the address is within range and valid for
  286. the size of the object. If an addressing error is found, a trap occurs.
  287. }
  288. function memw(a:adr):word;
  289. var b:word; i:integer;
  290. begin wordadr(a); b:=0;
  291. for i:=wsize-1 downto 0 do b:=256*b + data[a+i] ;
  292. memw:=b
  293. end;
  294. function memd(a:adr):double; { Always signed }
  295. var b:double; i:integer;
  296. begin wordadr(a); b:=data[a+2*wsize-1];
  297. if b>=128 then b:=b-256;
  298. for i:=2*wsize-2 downto 0 do b:=256*b + data[a+i] ;
  299. memd:=b
  300. end;
  301. function mema(a:adr):adr;
  302. var b:adr; i:integer;
  303. begin wordadr(a); b:=0;
  304. for i:=asize-1 downto 0 do b:=256*b + data[a+i] ;
  305. mema:=b
  306. end;
  307. function mems(a:adr;s:size):word;
  308. var i:integer; b:word;
  309. begin chkadr(a,s); b:=0; for i:=1 to s do b:=b*256+data[a+s-i]; mems:=b end;
  310. function memb(a:adr):byte;
  311. begin memadr(a); memb:=data[a] end;
  312. procedure store(a:adr; x:word);
  313. var i:integer;
  314. begin wordadr(a);
  315. for i:=0 to wsize-1 do
  316. begin data[a+i]:=x mod 256; x:=x div 256 end
  317. end;
  318. procedure storea(a:adr; x:adr);
  319. var i:integer;
  320. begin wordadr(a);
  321. for i:=0 to asize-1 do
  322. begin data[a+i]:=x mod 256; x:=x div 256 end
  323. end;
  324. procedure stores(a:adr;s:size;v:word);
  325. var i:integer;
  326. begin chkadr(a,s);
  327. for i:=0 to s-1 do begin data[a+i]:=v mod 256; v:=v div 256 end;
  328. end;
  329. procedure storeb(a:adr; b:byte);
  330. begin memadr(a); data[a]:=b end;
  331. function memi(a:adr):adr;
  332. var b:adr; i:integer;
  333. begin if (a mod wsize<>0) or (a+asize-1>maxcode) then trap(EBADPTR); b:=0;
  334. for i:=asize-1 downto 0 do b:=256*b + code[a+i] ;
  335. memi:=b
  336. end;
  337. function nextpc:byte;
  338. begin if pc>=pd then trap(EBADPC); nextpc:=code[pc]; newpc(pc+1) end;
  339. procedure lino(w:word);
  340. begin store(lineadr,w) end;
  341. procedure filna(a:adr);
  342. begin storea(fileadr,a) end;
  343. {
  344. .ne 20
  345. .sp 5
  346. {---------------------------------------------------------------------------}
  347. { Stack Manipulation Routines }
  348. {---------------------------------------------------------------------------}
  349. { push puts a word on the stack
  350. pushsw takes a signed one word integer and pushes it on the stack
  351. pop removes a machine word from the stack and delivers it as a word
  352. popsw removes a machine word from the stack and delivers a signed integer
  353. pusha pushes an address on the stack
  354. popa removes a machine word from the stack and delivers it as an address
  355. pushd pushes a double precision number on the stack
  356. popd removes two machine words and returns a double precision integer
  357. pushr pushes a float (floating point) number on the stack
  358. popr removes several machine words and returns a float number
  359. pushx puts an object of arbitrary size on the stack
  360. popx removes an object of arbitrary size
  361. }
  362. procedure push(x:word);
  363. begin newsp(sp-wsize); store(sp,x) end;
  364. procedure pushsw(x:sword);
  365. begin newsp(sp-wsize); store(sp,unsign(x)) end;
  366. function pop:word;
  367. begin pop:=memw(sp); newsp(sp+wsize) end;
  368. function popsw:sword;
  369. begin popsw:=signwd(pop) end;
  370. procedure pusha(x:adr);
  371. begin newsp(sp-asize); storea(sp,x) end;
  372. function popa:adr;
  373. begin popa:=mema(sp); newsp(sp+asize) end;
  374. procedure pushd(y:double);
  375. begin { push double integer onto the stack } newsp(sp-2*wsize) end;
  376. function popd:double;
  377. begin { pop double integer from the stack } newsp(sp+2*wsize); popd:=0 end;
  378. procedure pushr(z:real);
  379. begin { Push a float onto the stack } newsp(sp-fsize) end;
  380. function popr:real;
  381. begin { pop float from the stack } newsp(sp+fsize); popr:=0.0 end;
  382. procedure pushx(objsize:size; a:adr);
  383. var i:integer;
  384. begin
  385. if objsize<wsize
  386. then push(mems(a,objsize))
  387. else for i:=1 to objsize div wsize do push(memw(a+objsize-wsize*i))
  388. end;
  389. procedure popx(objsize:size; a:adr);
  390. var i:integer;
  391. begin
  392. if objsize<wsize
  393. then stores(a,objsize,pop)
  394. else for i:=1 to objsize div wsize do store(a-wsize+wsize*i,pop)
  395. end;
  396. {
  397. .ne 20
  398. .sp 5
  399. {---------------------------------------------------------------------------}
  400. { Bit manipulation routines (extract, shift, rotate) }
  401. {---------------------------------------------------------------------------}
  402. procedure sleft(var w:sword); { 1 bit left shift }
  403. begin w:= dosign(fitsw(2*w,EIOVFL)) end;
  404. procedure suleft(var w:word); { 1 bit left shift }
  405. begin w := chopw(2*w) end;
  406. procedure sdleft(var d:double); { 1 bit left shift }
  407. begin { shift two word signed integer } end;
  408. procedure sright(var w:sword); { 1 bit right shift with sign extension }
  409. begin if w >= 0 then w := w div 2 else w := (w-1) div 2 end;
  410. procedure suright(var w:word); { 1 bit right shift without sign extension }
  411. begin w := w div 2 end;
  412. procedure sdright(var d:double); { 1 bit right shift }
  413. begin { shift two word signed integer } end;
  414. procedure rleft(var w:word); { 1 bit left rotate }
  415. begin if w >= t15
  416. then w:=(w-t15)*2 + 1
  417. else w:=w*2
  418. end;
  419. procedure rright(var w:word); { 1 bit right rotate }
  420. begin if w mod 2 = 1
  421. then w:=w div 2 + t15
  422. else w:=w div 2
  423. end;
  424. function sextend(w:word;s:size):word;
  425. var i:size;
  426. begin
  427. for i:=1 to (wsize-s)*8 do rleft(w);
  428. for i:=1 to (wsize-s)*8 do sright(w);
  429. sextend:=w;
  430. end;
  431. function bit(b:bitnr; w:word):bitval; { return bit b of the word w }
  432. var i:bitnr;
  433. begin for i:= 1 to b do rright(w); bit:= w mod 2 end;
  434. function bf(ty:bftype; w1,w2:word):word; { return boolean fcn of 2 words }
  435. var i:bitnr; j:word;
  436. begin j:=0;
  437. for i:= maxbitnr downto 0 do
  438. begin j := 2*j;
  439. case ty of
  440. andf: if bit(i,w1)+bit(i,w2) = 2 then j:=j+1;
  441. iorf: if bit(i,w1)+bit(i,w2) > 0 then j:=j+1;
  442. xorf: if bit(i,w1)+bit(i,w2) = 1 then j:=j+1
  443. end
  444. end;
  445. bf:=j
  446. end;
  447. {---------------------------------------------------------------------------}
  448. { Array indexing
  449. {---------------------------------------------------------------------------}
  450. function arraycalc(c:adr):adr; { subscript calculation }
  451. var j:full; objsize:size; a:adr;
  452. begin j:= popsw - signwd(memw(c));
  453. if (j<0) or (j>memw(c+wsize)) then trap(EARRAY);
  454. objsize := argo(memw(c+wsize+wsize));
  455. a := j*objsize+popa; chkadr(a,objsize);
  456. arraycalc:=a
  457. end;
  458. {
  459. .ne 20
  460. .sp 5
  461. {---------------------------------------------------------------------------}
  462. { Double and Real Arithmetic }
  463. {---------------------------------------------------------------------------}
  464. { All routines for doubles and floats are dummy routines, since the format of
  465. doubles and floats is not defined in EM.
  466. }
  467. function doadi(ds,dt:double):double;
  468. begin { add two doubles } doadi:=0 end;
  469. function dosbi(ds,dt:double):double;
  470. begin { subtract two doubles } dosbi:=0 end;
  471. function domli(ds,dt:double):double;
  472. begin { multiply two doubles } domli:=0 end;
  473. function dodvi(ds,dt:double):double;
  474. begin { divide two doubles } dodvi:=0 end;
  475. function dormi(ds,dt:double):double;
  476. begin { modulo of two doubles } dormi:=0 end;
  477. function dongi(ds:double):double;
  478. begin { negative of a double } dongi:=0 end;
  479. function doadf(x,y:real):real;
  480. begin { add two floats } doadf:=0.0 end;
  481. function dosbf(x,y:real):real;
  482. begin { subtract two floats } dosbf:=0.0 end;
  483. function domlf(x,y:real):real;
  484. begin { multiply two floats } domlf:=0.0 end;
  485. function dodvf(x,y:real):real;
  486. begin { divide two floats } dodvf:=0.0 end;
  487. function dongf(x:real):real;
  488. begin { negate a float } dongf:=0.0 end;
  489. procedure dofif(x,y:real;var intpart,fraction:real);
  490. begin { dismember x*y into integer and fractional parts }
  491. intpart:=0.0; { integer part of x*y, same sign as x*y }
  492. fraction:=0.0;
  493. { fractional part of x*y, 0<=abs(fraction)<1 and same sign as x*y }
  494. end;
  495. procedure dofef(x:real;var mantissa:real;var exponent:sword);
  496. begin { dismember x into mantissa and exponent parts }
  497. mantissa:=0.0; { mantissa of x , >= 1/2 and <1 }
  498. exponent:=0; { base 2 exponent of x }
  499. end;
  500. {
  501. .ne 20
  502. .sp 5
  503. .bp
  504. {---------------------------------------------------------------------------}
  505. { Trap and Call }
  506. {---------------------------------------------------------------------------}
  507. procedure call(p:adr); { Perform the call }
  508. begin
  509. pusha(lb);pusha(pc);
  510. newlb(sp);newsp(sp - memi(pd + pdsize*p + pdlocs));
  511. newpc(memi(pd + pdsize*p+ pdbase))
  512. end;
  513. procedure dotrap(n:byte);
  514. var i:size;
  515. begin
  516. if (uerrorproc=0) or intrap then
  517. begin
  518. if intrap then
  519. writeln('Recursive trap, first trap number was ', trapval:1);
  520. writeln('Error ', n:1);
  521. writeln('With',ord(insr):4,' arg ',k:1);
  522. #ifndef DOC
  523. writecore(n);
  524. #endif
  525. goto 9999
  526. end;
  527. { Deposit all interpreter variables that need to be saved on
  528. the stack. This includes all scratch variables that can
  529. be in use at the moment and ( not possible in this interpreter )
  530. the internal address of the interpreter where the error occurred.
  531. This would make it possible to execute an RTT instruction totally
  532. transparent to the user program.
  533. It can, for example, occur within an ADD instruction that both
  534. operands are undefined and that the result overflows.
  535. Although this will generate 3 error traps it must be possible
  536. to ignore them all.
  537. }
  538. intrap:=true; trapval:=n;
  539. for i:=retsize div wsize downto 1 do push(retarea[i]);
  540. push(retsize); { saved return area }
  541. pusha(mema(fileadr)); { saved current file name pointer }
  542. push(memw(lineadr)); { saved line number }
  543. push(n); { push error number }
  544. a:=argp(uerrorproc);
  545. uerrorproc:=0; { reset signal }
  546. call(a); { call the routine }
  547. intrap:=false; { Do not catch recursive traps anymore }
  548. goto 8888; { reenter main loop }
  549. end;
  550. procedure trap;
  551. { This routine is invoked for overflow, and other run time errors.
  552. For non-fatal errors, trap returns to the calling routine
  553. }
  554. begin
  555. if n>=16 then dotrap(n) else if bit(n,ignmask)=0 then dotrap(n);
  556. end;
  557. procedure dortt;
  558. { The restoration of file address and line number is not essential.
  559. The restoration of the return save area is.
  560. }
  561. var i:size;
  562. n:word;
  563. begin
  564. newsp(lb); lb:=maxdata+1 ; { to circumvent ESTACK for the popa + pop }
  565. newpc(popa); newlb(popa); { So far a plain RET 0 }
  566. n:=pop; if (n>=16) and (n<64) then
  567. begin
  568. #ifndef DOC
  569. writecore(n);
  570. #endif
  571. goto 9999
  572. end;
  573. lino(pop); filna(popa); retsize:=pop;
  574. for i:=1 to retsize div wsize do retarea[i]:=pop ;
  575. end;
  576. {
  577. .sp 5
  578. {---------------------------------------------------------------------------}
  579. { monitor calls }
  580. {---------------------------------------------------------------------------}
  581. procedure domon(entry:word);
  582. var index: 1..63;
  583. dummy: double;
  584. count,rwptr: adr;
  585. token: byte;
  586. i: integer;
  587. begin
  588. if (entry<=0) or (entry>63) then entry:=63 ;
  589. index:=entry;
  590. case index of
  591. 1: begin { exit } exitstatus:=pop; halted:=true end;
  592. 3: begin { read } dummy:=pop; { All input is from stdin }
  593. rwptr:=popa; count:=popa;
  594. i:=0 ;
  595. while (not eof(input)) and (i<count) do
  596. begin
  597. if eoln(input) then begin storeb(rwptr,10) ; count:=i end
  598. else storeb(rwptr,ord(input^)) ;
  599. get(input); rwptr:=rwptr+1 ; i:=i+1 ;
  600. end;
  601. pusha(i); push(0)
  602. end;
  603. 4: begin { write } dummy:=pop; { All output is to stdout }
  604. rwptr:=popa; count:=popa;
  605. for i:=1 to count do
  606. begin token:=memb(rwptr); rwptr:=rwptr+1 ;
  607. if token=10 then writeln else write(chr(token))
  608. end ;
  609. pusha(count);
  610. push(0)
  611. end;
  612. 54: begin { ioctl, faked } dummy:=popa;dummy:=popa;dummy:=pop;push(0) end ;
  613. 2, 5, 6, 7, 8, 9, 10,
  614. 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
  615. 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
  616. 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  617. 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
  618. 51, 52, 53, 55, 56, 57, 58, 59, 60,
  619. 61, 62:
  620. begin push(22); push(22) end;
  621. 63: { exists only for the trap }
  622. trap(EBADMON)
  623. end
  624. end;
  625. {
  626. .bp
  627. {---------------------------------------------------------------------------}
  628. { Initialization and debugging }
  629. {---------------------------------------------------------------------------}
  630. procedure doident; { print line number and file name }
  631. var a:adr; i,c:integer; found:boolean;
  632. begin
  633. write('at line ',memw(lineadr):1,' ');
  634. a:=mema(fileadr); if a<>0 then
  635. begin i:=20; found:=false;
  636. while (i<>0) and not found do
  637. begin c:=memb(a); a:=a+1; found:=true; i:=i-1;
  638. if (c>=48) and (c<=57) then
  639. begin found:=false; write(chr(ord('0')+c-48)) end;
  640. if (c>=65) and (c<=90) then
  641. begin found:=false; write(chr(ord('A')+c-65)) end;
  642. if (c>=97) and (c<=122) then
  643. begin found:=false; write(chr(ord('a')+c-97)) end;
  644. end;
  645. end;
  646. writeln;
  647. end;
  648. #ifndef DOC
  649. {---------------------------------------------------------------------------}
  650. { Post Mortem Dump }
  651. { }
  652. {This a not a part of the machine definition, but an ad hoc debugging method}
  653. {---------------------------------------------------------------------------}
  654. procedure writecore;
  655. var ncoreb,i:integer;
  656. procedure wrbyte(b:byte);
  657. begin write(core,b); ncoreb:=ncoreb+1 end;
  658. procedure wradr(a:adr);
  659. var i:integer;
  660. begin for i:=1 to asize do begin wrbyte(a mod 256); a:=a div 256 end end;
  661. begin
  662. rewrite(core); ncoreb:=0;
  663. wrbyte(173); wrbyte(16); { Magic }
  664. wrbyte(3);wrbyte(0); { Version }
  665. wrbyte(wsize);wrbyte(0); { Wordsize }
  666. wrbyte(asize);wrbyte(0); { Address size }
  667. wradr(0); { Text size in dump }
  668. wradr(maxdata+1); { Data size in dump }
  669. wradr(ignmask);
  670. wradr(uerrorproc);
  671. wradr(n); { Cause }
  672. wradr(pc); wradr(sp); wradr(lb); wradr(hp); wradr(pd); wradr(0){pb} ;
  673. while ncoreb<>512 do wradr(0); { Fill }
  674. for i:=0 to maxdata do wrbyte(data[i])
  675. end;
  676. #endif
  677. procedure initialize; { start the ball rolling }
  678. { This is not part of the machine definition }
  679. var cset:set of char;
  680. f:ifset;
  681. iclass:insclass;
  682. insno:byte;
  683. nops:integer;
  684. opcode:byte;
  685. i,j,n:integer;
  686. wtemp:sword;
  687. count:integer;
  688. repc:adr;
  689. nexta,firsta:adr;
  690. elem:byte;
  691. amount,ofst:size;
  692. c:char;
  693. function readb(n:integer):double;
  694. var b:byte;
  695. begin read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b end;
  696. function readbyte:byte;
  697. begin readbyte:=readb(1) end;
  698. function readword:word;
  699. begin readword:=readb(wsize) end;
  700. function readadr:adr;
  701. begin readadr:=readb(asize) end;
  702. function ifind(ordinal:byte):mnem;
  703. var loopvar:mnem;
  704. found:boolean;
  705. begin ifind:=NON;
  706. loopvar:=insr; found:=false;
  707. repeat
  708. if ordinal=ord(loopvar) then
  709. begin found:=true; ifind:=loopvar end;
  710. if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON;
  711. until found or (loopvar=insr) ;
  712. end;
  713. procedure readhdr;
  714. type hdrw=0..32767 ; { 16 bit header words }
  715. var hdr: hdrw;
  716. i: integer;
  717. begin
  718. for i:=0 to 7 do
  719. begin hdr:=readb(2);
  720. case i of
  721. 0: if hdr<>3757 then { 07255 }
  722. begin writeln('Not an em load file'); halt end;
  723. 2: if hdr<>0 then
  724. begin writeln('Unsolved references'); halt end;
  725. 3: if hdr<>3 then
  726. begin writeln('Incorrect load file version'); halt end;
  727. 4: if hdr<>wsize then
  728. begin writeln('Incorrect word size'); halt end;
  729. 5: if hdr<>asize then
  730. begin writeln('Incorrect pointer size'); halt end;
  731. 1,6,7:;
  732. end
  733. end
  734. end;
  735. procedure noinit;
  736. begin writeln('Illegal initialization'); halt end;
  737. procedure readint(a:adr;s:size);
  738. var i:size;
  739. begin { construct integer out of byte sequence }
  740. for i:=1 to s do { construct the value and initialize at a }
  741. begin storeb(a,readbyte); a:=a+1 end
  742. end;
  743. procedure readuns(a:adr;s:size);
  744. begin { construct unsigned out of byte sequence }
  745. readint(a,s) { identical to readint }
  746. end;
  747. procedure readfloat(a:adr;s:size);
  748. var i:size; b:byte;
  749. begin { construct float out of string}
  750. if (s<>4) and (s<>8) then noinit; i:=0;
  751. repeat { eat the bytes, construct the value and intialize at a }
  752. b:=readbyte; i:=i+1;
  753. until b=0 ;
  754. end;
  755. begin
  756. halted:=false;
  757. exitstatus:=undef;
  758. uerrorproc:=0; intrap:=false;
  759. { initialize tables }
  760. for i:=0 to maxcode do code[i]:=0;
  761. for i:=0 to maxdata do data[i]:=0;
  762. for iclass:=prim to tert do
  763. for i:=0 to 255 do
  764. with dispat[iclass][i] do
  765. begin instr:=NON; iflag:=[zbit] end;
  766. { read instruction table file. see appendix B }
  767. { The table read here is a simple transformation of the table on page xx }
  768. { - instruction names were transformed to numbers }
  769. { - the '-' flag was transformed to an 'i' flag for 'w' type instructions }
  770. { - the 'S' flag was added for instructions having signed operands }
  771. reset(tables);
  772. insr:=NON;
  773. repeat
  774. read(tables,insno) ; cset:=[]; f:=[];
  775. insr:=ifind(insno);
  776. if insr=NON then begin writeln('Incorrect table'); halt end;
  777. repeat read(tables,c) until c<>' ' ;
  778. repeat
  779. cset:=cset+[c];
  780. read(tables,c)
  781. until c=' ' ;
  782. if 'm' in cset then f:=f+[mini];
  783. if 's' in cset then f:=f+[short];
  784. if '-' in cset then f:=f+[zbit];
  785. if 'i' in cset then f:=f+[ibit];
  786. if 'S' in cset then f:=f+[sbit];
  787. if 'w' in cset then f:=f+[wbit];
  788. if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ;
  789. readln(tables,opcode);
  790. if ('4' in cset) or ('8' in cset) then
  791. begin iclass:=tert end
  792. else if 'e' in cset then
  793. begin iclass:=second end
  794. else iclass:=prim;
  795. for i:=0 to nops-1 do
  796. begin
  797. with dispat[iclass,opcode+i] do
  798. begin
  799. iflag:=f; instr:=insr;
  800. if '2' in cset then ilength:=2
  801. else if 'u' in cset then ilength:=2
  802. else if '4' in cset then ilength:=4
  803. else if '8' in cset then ilength:=8
  804. else if (mini in f) or (short in f) then
  805. begin
  806. if 'N' in cset then wtemp:=-1-i else wtemp:=i ;
  807. if 'o' in cset then wtemp:=wtemp+1 ;
  808. if short in f then wtemp:=wtemp*256 ;
  809. implicit:=wtemp
  810. end
  811. end
  812. end
  813. until eof(tables);
  814. { read in program text, data and procedure descriptors }
  815. reset(prog);
  816. readhdr; { verify first header }
  817. for i:=1 to 8 do header[i]:=readadr; { read second header }
  818. hp:=maxdata+1; sp:=maxdata+1; lino(0);
  819. { read program text }
  820. if header[NTEXT]+header[NPROC]*pdsize>maxcode then
  821. begin writeln('Text size too large'); halt end;
  822. if header[SZDATA]>maxdata then
  823. begin writeln('Data size too large'); halt end;
  824. for i:=0 to header[NTEXT]-1 do code[i]:=readbyte;
  825. { read data blocks }
  826. nexta:=0;
  827. for i:=1 to header[NDATA] do
  828. begin
  829. n:=readbyte;
  830. if n<>0 then
  831. begin
  832. elem:=readbyte; firsta:=nexta;
  833. case n of
  834. 1: { uninitialized words }
  835. for j:=1 to elem do
  836. begin store(nexta,undef); nexta:=nexta+wsize end;
  837. 2: { initialized bytes }
  838. for j:=1 to elem do
  839. begin storeb(nexta,readbyte); nexta:=nexta+1 end;
  840. 3: { initialized words }
  841. for j:=1 to elem do
  842. begin store(nexta,readword); nexta:=nexta+wsize end;
  843. 4,5: { instruction and data pointers }
  844. for j:=1 to elem do
  845. begin storea(nexta,readadr); nexta:=nexta+asize end;
  846. 6: { signed integers }
  847. begin readint(nexta,elem); nexta:=nexta+elem end;
  848. 7: { unsigned integers }
  849. begin readuns(nexta,elem); nexta:=nexta+elem end;
  850. 8: { floating point numbers }
  851. begin readfloat(nexta,elem); nexta:=nexta+elem end;
  852. end
  853. end
  854. else
  855. begin
  856. repc:=readadr;
  857. amount:=nexta-firsta;
  858. for count:=1 to repc do
  859. begin
  860. for ofst:=0 to amount-1 do data[nexta+ofst]:=data[firsta+ofst];
  861. nexta:=nexta+amount;
  862. end
  863. end
  864. end;
  865. if header[SZDATA]<>nexta then writeln('Data initialization error');
  866. hp:=nexta;
  867. { read descriptor table }
  868. pd:=header[NTEXT];
  869. for i:=1 to header[NPROC]*pdsize do code[pd+i-1]:=readbyte;
  870. { call the entry point routine }
  871. ignmask:=0; { catch all traps, higher numbered traps cannot be ignored}
  872. retsize:=0;
  873. lb:=maxdata; { illegal dynamic link }
  874. pc:=maxcode; { illegal return address }
  875. push(0); a:=sp; { No environment }
  876. push(0); b:=sp; { No args }
  877. pusha(a); { envp }
  878. pusha(b); { argv }
  879. push(0); { argc }
  880. call(argp(header[ENTRY]));
  881. end;
  882. {
  883. .bp
  884. {---------------------------------------------------------------------------}
  885. { MAIN LOOP OF THE INTERPRETER }
  886. {---------------------------------------------------------------------------}
  887. { It should be noted that the interpreter (microprogram) for an EM
  888. machine can be written in two fundamentally different ways: (1) the
  889. instruction operands are fetched in the main loop, or (2) the in-
  890. struction operands are fetched after the 256 way branch, by the exe-
  891. cution routines themselves. In this interpreter, method (1) is used
  892. to simplify the description of execution routines. The dispatch
  893. table dispat is used to determine how the operand is encoded. There
  894. are 4 possibilities:
  895. 0. There is no operand
  896. 1. The operand and instruction are together in 1 byte (mini)
  897. 2. The operand is one byte long and follows the opcode byte(s)
  898. 3. The operand is two bytes long and follows the opcode byte(s)
  899. 4. The operand is four bytes long and follows the opcode byte(s)
  900. In this interpreter, the main loop determines the operand type,
  901. fetches it, and leaves it in the global variable k for the execution
  902. routines to use. Consequently, instructions such as LOL, which use
  903. three different formats, need only be described once in the body of
  904. the interpreter.
  905. However, for a production interpreter, or a hardware EM
  906. machine, it is probably better to use method (2), i.e. to let the
  907. execution routines themselves fetch their own operands. The reason
  908. for this is that each opcode uniquely determines the operand format,
  909. so no table lookup in the dispatch table is needed. The whole table
  910. is not needed. Method (2) therefore executes much faster.
  911. However, separate execution routines will be needed for LOL with
  912. a one byte offset, and LOL with a two byte offset. It is to avoid
  913. this additional clutter that method (1) is used here. In a produc-
  914. tion interpreter, it is envisioned that the main loop will fetch the
  915. next instruction byte, and use it as an index into a 256 word table
  916. to find the address of the interpreter routine to jump to. The
  917. routine jumped to will begin by fetching its operand, if any,
  918. without any table lookup, since it knows which format to expect.
  919. After doing the work, it returns to the main loop by jumping in-
  920. directly to a register that contains the address of the main loop.
  921. A slight variation on this idea is to have the register contain
  922. the address of the branch table, rather than the address of the main
  923. loop.
  924. Another issue is whether the execution routines for LOL 0, LOL
  925. 2, LOL 4, etc. should all be have distinct execution routines. Doing
  926. so provides for the maximum speed, since the operand is implicit in
  927. the routine itself. The disadvantage is that many nearly identical
  928. execution routines will then be needed. Another way of doing it is
  929. to keep the instruction byte fetched from memory (LOL 0, LOL 2, LOL
  930. 4, etc.) in some register, and have all the LOL mini format instruc-
  931. tions branch to a common routine. This routine can then determine
  932. the operand by subtracting the code for LOL 0 from the register,
  933. leaving the true operand in the register (as a word quantity of
  934. course). This method makes the interpreter smaller, but is a bit
  935. slower.
  936. .bp
  937. To make this important point a little clearer, consider how a
  938. production interpreter for the PDP-11 might appear. Let us assume the
  939. following opcodes have been assigned:
  940. 31: LOL -2 (2 bytes, i.e. next word)
  941. 32: LOL -4
  942. 33: LOL -6
  943. 34: LOL b (format with a one byte offset)
  944. 35: LOL w (format with a one word, i.e. two byte offset)
  945. Further assume that each of the 5 opcodes will have its own execution
  946. routine, i.e. we are making a tradeoff in favor of fast execution and
  947. a slightly larger interpreter.
  948. Register r5 is the em program counter.
  949. Register r4 is the em LB register
  950. Register r3 is the em SP register (the stack grows toward low core)
  951. Register r2 contains the interpreter address of the main loop
  952. The main loop looks like this:
  953. movb (r5)+,r0 /fetch the opcode into r0 and increment r5
  954. asl r0 /shift r0 left 1 bit. Now: -256<=r0<=+254
  955. jmp *table(r0) /jump to execution routine
  956. Notice that no operand fetching has been done. The execution routines for
  957. the 5 sample instructions given above might be as follows:
  958. lol2: mov -2(r4),-(sp) /push local -2 onto stack
  959. jmp (r2) /go back to main loop
  960. lol4: mov -4(r4),-(sp) /push local -4 onto stack
  961. jmp (r2) /go back to main loop
  962. lol6: mov -6(r4),-(sp) /push local -6 onto stack
  963. jmp (r2) /go back to main loop
  964. lolb: mov $177400,r0 /prepare to fetch the 1 byte operand
  965. bisb (r5)+,r0 /operand is now in r0
  966. asl r0 /r0 is now offset from LB in bytes, not words
  967. add r4,r0 /r0 is now address of the needed local
  968. mov (r0),-(sp) /push the local onto the stack
  969. jmp (r2)
  970. lolw: clr r0 /prepare to fetch the 2 byte operand
  971. bisb (r5)+,r0 /fetch high order byte first !!!
  972. swab r0 /insert high order byte in place
  973. bisb (r5)+,r0 /insert low order byte in place
  974. asl r0 /convert offset to bytes, from words
  975. add r4,r0 /r0 is now address of needed local
  976. mov (r0),-(sp) /stack the local
  977. jmp (r2) /done
  978. The important thing to notice is where and how the operand fetch occurred:
  979. lol2, lol4, and lol6, (the minis) have implicit operands
  980. lolb knew it had to fetch one byte, and did so without any table lookup
  981. lolw knew it had to fetch a word, and did so, high order byte first }
  982. {
  983. .bp
  984. .sp 4
  985. {---------------------------------------------------------------------------}
  986. { Routines for the individual instructions }
  987. {---------------------------------------------------------------------------}
  988. procedure loadops;
  989. var j:integer;
  990. begin
  991. case insr of
  992. { LOAD GROUP }
  993. LDC: pushd(argd(k));
  994. LOC: pushsw(argc(k));
  995. LOL: push(memw(locadr(k)));
  996. LOE: push(memw(argg(k)));
  997. LIL: push(memw(mema(locadr(k))));
  998. LOF: push(memw(popa+argf(k)));
  999. LAL: pusha(locadr(k));
  1000. LAE: pusha(argg(k));
  1001. LXL: begin a:=lb; for j:=1 to argn(k) do a:=mema(a+savsize); pusha(a) end;
  1002. LXA: begin a:=lb;
  1003. for j:=1 to argn(k) do a:= mema(a+savsize);
  1004. pusha(a+savsize)
  1005. end;
  1006. LOI: pushx(argo(k),popa);
  1007. LOS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
  1008. k:=pop; pushx(argo(k),popa)
  1009. end;
  1010. LDL: begin a:=locadr(k); push(memw(a+wsize)); push(memw(a)) end;
  1011. LDE: begin k:=argg(k); push(memw(k+wsize)); push(memw(k)) end;
  1012. LDF: begin k:=argf(k);
  1013. a:=popa; push(memw(a+k+wsize)); push(memw(a+k))
  1014. end;
  1015. LPI: push(argp(k))
  1016. end
  1017. end;
  1018. procedure storeops;
  1019. begin
  1020. case insr of
  1021. { STORE GROUP }
  1022. STL: store(locadr(k),pop);
  1023. STE: store(argg(k),pop);
  1024. SIL: store(mema(locadr(k)),pop);
  1025. STF: begin a:=popa; store(a+argf(k),pop) end;
  1026. STI: popx(argo(k),popa);
  1027. STS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
  1028. k:=popa; popx(argo(k),popa)
  1029. end;
  1030. SDL: begin a:=locadr(k); store(a,pop); store(a+wsize,pop) end;
  1031. SDE: begin k:=argg(k); store(k,pop); store(k+wsize,pop) end;
  1032. SDF: begin k:=argf(k); a:=popa; store(a+k,pop); store(a+k+wsize,pop) end
  1033. end
  1034. end;
  1035. procedure intarith;
  1036. var i:integer;
  1037. begin
  1038. case insr of
  1039. { SIGNED INTEGER ARITHMETIC }
  1040. ADI: case szindex(argw(k)) of
  1041. 1: begin st:=popsw; ss:=popsw; push(fitsw(ss+st,EIOVFL)) end;
  1042. 2: begin dt:=popd; ds:=popd; pushd(doadi(ds,dt)) end;
  1043. end ;
  1044. SBI: case szindex(argw(k)) of
  1045. 1: begin st:=popsw; ss:= popsw; push(fitsw(ss-st,EIOVFL)) end;
  1046. 2: begin dt:=popd; ds:=popd; pushd(dosbi(ds,dt)) end;
  1047. end ;
  1048. MLI: case szindex(argw(k)) of
  1049. 1: begin st:=popsw; ss:= popsw; push(fitsw(ss*st,EIOVFL)) end;
  1050. 2: begin dt:=popd; ds:=popd; pushd(domli(ds,dt)) end;
  1051. end ;
  1052. DVI: case szindex(argw(k)) of
  1053. 1: begin st:= popsw; ss:= popsw;
  1054. if st=0 then trap(EIDIVZ) else pushsw(ss div st)
  1055. end;
  1056. 2: begin dt:=popd; ds:=popd; pushd(dodvi(ds,dt)) end;
  1057. end;
  1058. RMI: case szindex(argw(k)) of
  1059. 1: begin st:= popsw; ss:=popsw;
  1060. if st=0 then trap(EIDIVZ) else pushsw(ss - (ss div st)*st)
  1061. end;
  1062. 2: begin dt:=popd; ds:=popd; pushd(dormi(ds,dt)) end
  1063. end;
  1064. NGI: case szindex(argw(k)) of
  1065. 1: begin st:=popsw; pushsw(-st) end;
  1066. 2: begin ds:=popd; pushd(dongi(ds)) end
  1067. end;
  1068. SLI: begin t:=pop;
  1069. case szindex(argw(k)) of
  1070. 1: begin ss:=popsw;
  1071. for i:= 1 to t do sleft(ss); pushsw(ss)
  1072. end
  1073. end
  1074. end;
  1075. SRI: begin t:=pop;
  1076. case szindex(argw(k)) of
  1077. 1: begin ss:=popsw;
  1078. for i:= 1 to t do sright(ss); pushsw(ss)
  1079. end;
  1080. 2: begin ds:=popd;
  1081. for i:= 1 to t do sdright(ss); pushd(ss)
  1082. end
  1083. end
  1084. end
  1085. end
  1086. end;
  1087. procedure unsarith;
  1088. var i:integer;
  1089. begin
  1090. case insr of
  1091. { UNSIGNED INTEGER ARITHMETIC }
  1092. ADU: case szindex(argw(k)) of
  1093. 1: begin t:=pop; s:= pop; push(chopw(s+t)) end;
  1094. 2: trap(EILLINS);
  1095. end ;
  1096. SBU: case szindex(argw(k)) of
  1097. 1: begin t:=pop; s:= pop; push(chopw(s-t)) end;
  1098. 2: trap(EILLINS);
  1099. end ;
  1100. MLU: case szindex(argw(k)) of
  1101. 1: begin t:=pop; s:= pop; push(chopw(s*t)) end;
  1102. 2: trap(EILLINS);
  1103. end ;
  1104. DVU: case szindex(argw(k)) of
  1105. 1: begin t:= pop; s:= pop;
  1106. if t=0 then trap(EIDIVZ) else push(s div t)
  1107. end;
  1108. 2: trap(EILLINS);
  1109. end;
  1110. RMU: case szindex(argw(k)) of
  1111. 1: begin t:= pop; s:=pop;
  1112. if t=0 then trap(EIDIVZ) else push(s - (s div t)*t)
  1113. end;
  1114. 2: trap(EILLINS);
  1115. end;
  1116. SLU: case szindex(argw(k)) of
  1117. 1: begin t:=pop; s:=pop;
  1118. for i:= 1 to t do suleft(s); push(s)
  1119. end;
  1120. 2: trap(EILLINS);
  1121. end;
  1122. SRU: case szindex(argw(k)) of
  1123. 1: begin t:=pop; s:=pop;
  1124. for i:= 1 to t do suright(s); push(s)
  1125. end;
  1126. 2: trap(EILLINS);
  1127. end
  1128. end
  1129. end;
  1130. procedure fltarith;
  1131. begin
  1132. case insr of
  1133. { FLOATING POINT ARITHMETIC }
  1134. ADF: begin argwf(k); rt:=popr; rs:=popr; pushr(doadf(rs,rt)) end;
  1135. SBF: begin argwf(k); rt:=popr; rs:=popr; pushr(dosbf(rs,rt)) end;
  1136. MLF: begin argwf(k); rt:=popr; rs:=popr; pushr(domlf(rs,rt)) end;
  1137. DVF: begin argwf(k); rt:=popr; rs:=popr; pushr(dodvf(rs,rt)) end;
  1138. NGF: begin argwf(k); rt:=popr; pushr(dongf(rt)) end;
  1139. FIF: begin argwf(k); rt:=popr; rs:=popr;
  1140. dofif(rt,rs,x,y); pushr(y); pushr(x)
  1141. end;
  1142. FEF: begin argwf(k); rt:=popr; dofef(rt,x,ss); pushr(x); pushsw(ss) end
  1143. end
  1144. end;
  1145. procedure ptrarith;
  1146. begin
  1147. case insr of
  1148. { POINTER ARITHMETIC }
  1149. ADP: pusha(popa+argf(k));
  1150. ADS: case szindex(argw(k)) of
  1151. 1: begin st:=popsw; pusha(popa+st) end;
  1152. 2: begin dt:=popd; pusha(popa+dt) end;
  1153. end;
  1154. SBS: begin
  1155. a:=popa; b:=popa;
  1156. case szindex(argw(k)) of
  1157. 1: push(fitsw(b-a,EIOVFL));
  1158. 2: pushd(b-a)
  1159. end
  1160. end
  1161. end
  1162. end;
  1163. procedure incops;
  1164. var j:integer;
  1165. begin
  1166. case insr of
  1167. { INCREMENT/DECREMENT/ZERO }
  1168. INC: push(fitsw(popsw+1,EIOVFL));
  1169. INL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
  1170. INE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
  1171. DEC: push(fitsw(popsw-1,EIOVFL));
  1172. DEL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
  1173. DEE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
  1174. ZRL: store(locadr(k),0);
  1175. ZRE: store(argg(k),0);
  1176. ZER: for j:=1 to argw(k) div wsize do push(0);
  1177. ZRF: pushr(0);
  1178. end
  1179. end;
  1180. procedure convops;
  1181. begin
  1182. case insr of
  1183. { CONVERT GROUP }
  1184. CII: begin s:=pop; t:=pop;
  1185. if t<wsize then begin push(sextend(pop,t)); t:=wsize end;
  1186. case szindex(argw(t)) of
  1187. 1: if szindex(argw(s))=2 then pushd(popsw);
  1188. 2: if szindex(argw(s))=1 then push(fitsw(popd,ECONV))
  1189. end
  1190. end;
  1191. CIU: case szindex(argw(pop)) of
  1192. 1: if szindex(argw(pop))=2 then push(unsign(popd mod negoff));
  1193. 2: trap(EILLINS);
  1194. end;
  1195. CIF: begin argwf(pop);
  1196. case szindex(argw(pop)) of 1:pushr(popsw); 2:pushr(popd) end
  1197. end;
  1198. CUI: case szindex(argw(pop)) of
  1199. 1: case szindex(argw(pop)) of
  1200. 1: begin s:=pop; if s>maxsint then trap(ECONV); push(s) end;
  1201. 2: trap(EILLINS);
  1202. end;
  1203. 2: case szindex(argw(pop)) of
  1204. 1: pushd(pop);
  1205. 2: trap(EILLINS);
  1206. end;
  1207. end;
  1208. CUU: case szindex(argw(pop)) of
  1209. 1: if szindex(argw(pop))=2 then trap(EILLINS);
  1210. 2: trap(EILLINS);
  1211. end;
  1212. CUF: begin argwf(pop);
  1213. if szindex(argw(pop))=1 then pushr(pop) else trap(EILLINS)
  1214. end;
  1215. CFI: begin sz:=argw(pop); argwf(pop); rt:=popr;
  1216. case szindex(sz) of
  1217. 1: push(fitsw(trunc(rt),ECONV));
  1218. 2: pushd(fitd(trunc(rt)));
  1219. end
  1220. end;
  1221. CFU: begin sz:=argw(pop); argwf(pop); rt:=popr;
  1222. case szindex(sz) of
  1223. 1: push( chopw(trunc(abs(rt)-0.5)) );
  1224. 2: trap(EILLINS);
  1225. end
  1226. end;
  1227. CFF: begin argwf(pop); argwf(pop) end
  1228. end
  1229. end;
  1230. procedure logops;
  1231. var i,j:integer;
  1232. begin
  1233. case insr of
  1234. { LOGICAL GROUP }
  1235. XAND:
  1236. begin k:=argw(k);
  1237. for j:= 1 to k div wsize do
  1238. begin a:=sp+k; t:=pop; store(a,bf(andf,memw(a),t)) end;
  1239. end;
  1240. IOR:
  1241. begin k:=argw(k);
  1242. for j:= 1 to k div wsize do
  1243. begin a:=sp+k; t:=pop; store(a,bf(iorf,memw(a),t)) end;
  1244. end;
  1245. XOR:
  1246. begin k:=argw(k);
  1247. for j:= 1 to k div wsize do
  1248. begin a:=sp+k; t:=pop; store(a,bf(xorf,memw(a),t)) end;
  1249. end;
  1250. COM:
  1251. begin k:=argw(k);
  1252. for j:= 1 to k div wsize do
  1253. begin
  1254. store(sp+k-wsize*j, bf(xorf,memw(sp+k-wsize*j), negoff-1))
  1255. end
  1256. end;
  1257. ROL: begin k:=argw(k); if k<>wsize then trap(EILLINS);
  1258. t:=pop; s:=pop; for i:= 1 to t do rleft(s); push(s)
  1259. end;
  1260. ROR: begin k:=argw(k); if k<>wsize then trap(EILLINS);
  1261. t:=pop; s:=pop; for i:= 1 to t do rright(s); push(s)
  1262. end
  1263. end
  1264. end;
  1265. procedure setops;
  1266. var i,j:integer;
  1267. begin
  1268. case insr of
  1269. { SET GROUP }
  1270. INN:
  1271. begin k:=argw(k);
  1272. t:=pop;
  1273. i:= t mod 8; t:= t div 8;
  1274. if t>=k then
  1275. begin trap(ESET); s:=0 end
  1276. else
  1277. begin s:=memb(sp+t) end;
  1278. newsp(sp+k); push(bit(i,s));
  1279. end;
  1280. XSET:
  1281. begin k:=argw(k);
  1282. t:=pop;
  1283. i:= t mod 8; t:= t div 8;
  1284. for j:= 1 to k div wsize do push(0);
  1285. if t>=k then
  1286. trap(ESET)
  1287. else
  1288. begin s:=1; for j:= 1 to i do rleft(s); storeb(sp+t,s) end
  1289. end
  1290. end
  1291. end;
  1292. procedure arrops;
  1293. begin
  1294. case insr of
  1295. { ARRAY GROUP }
  1296. LAR:
  1297. begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
  1298. pushx(argo(memw(a+2*k)),arraycalc(a))
  1299. end;
  1300. SAR:
  1301. begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
  1302. popx(argo(memw(a+2*k)),arraycalc(a))
  1303. end;
  1304. AAR:
  1305. begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
  1306. push(arraycalc(a))
  1307. end
  1308. end
  1309. end;
  1310. procedure cmpops;
  1311. begin
  1312. case insr of
  1313. { COMPARE GROUP }
  1314. CMI: case szindex(argw(k)) of
  1315. 1: begin st:=popsw; ss:=popsw;
  1316. if ss<st then pushsw(-1) else if ss=st then push(0) else push(1)
  1317. end;
  1318. 2: begin dt:=popd; ds:=popd;
  1319. if ds<dt then pushsw(-1) else if ds=dt then push(0) else push(1)
  1320. end;
  1321. end;
  1322. CMU: case szindex(argw(k)) of
  1323. 1: begin t:=pop; s:=pop;
  1324. if s<t then pushsw(-1) else if s=t then push(0) else push(1)
  1325. end;
  1326. 2: trap(EILLINS);
  1327. end;
  1328. CMP: begin a:=popa; b:=popa;
  1329. if b<a then pushsw(-1) else if b=a then push(0) else push(1)
  1330. end;
  1331. CMF: begin argwf(k); rt:=popr; rs:=popr;
  1332. if rs<rt then pushsw(-1) else if rs=rt then push(0) else push(1)
  1333. end;
  1334. CMS: begin k:=argw(k);
  1335. t:= 0; j:= 0;
  1336. while (j < k) and (t=0) do
  1337. begin if memw(sp+j) <> memw(sp+k+j) then t:=1;
  1338. j:=j+wsize
  1339. end;
  1340. newsp(sp+wsize*k); push(t);
  1341. end;
  1342. TLT: if popsw < 0 then push(1) else push(0);
  1343. TLE: if popsw <= 0 then push(1) else push(0);
  1344. TEQ: if pop = 0 then push(1) else push(0);
  1345. TNE: if pop <> 0 then push(1) else push(0);
  1346. TGE: if popsw >= 0 then push(1) else push(0);
  1347. TGT: if popsw > 0 then push(1) else push(0);
  1348. end
  1349. end;
  1350. procedure branchops;
  1351. begin
  1352. case insr of
  1353. { BRANCH GROUP }
  1354. BRA: newpc(pc+k);
  1355. BLT: begin st:=popsw; if popsw < st then newpc(pc+k) end;
  1356. BLE: begin st:=popsw; if popsw <= st then newpc(pc+k) end;
  1357. BEQ: begin t :=pop ; if pop = t then newpc(pc+k) end;
  1358. BNE: begin t :=pop ; if pop <> t then newpc(pc+k) end;
  1359. BGE: begin st:=popsw; if popsw >= st then newpc(pc+k) end;
  1360. BGT: begin st:=popsw; if popsw > st then newpc(pc+k) end;
  1361. ZLT: if popsw < 0 then newpc(pc+k);
  1362. ZLE: if popsw <= 0 then newpc(pc+k);
  1363. ZEQ: if pop = 0 then newpc(pc+k);
  1364. ZNE: if pop <> 0 then newpc(pc+k);
  1365. ZGE: if popsw >= 0 then newpc(pc+k);
  1366. ZGT: if popsw > 0 then newpc(pc+k)
  1367. end
  1368. end;
  1369. procedure callops;
  1370. var j:integer;
  1371. begin
  1372. case insr of
  1373. { PROCEDURE CALL GROUP }
  1374. CAL: call(argp(k));
  1375. CAI: begin call(argp(popa)) end;
  1376. RET: begin k:=argz(k); if k div wsize>maxret then trap(EILLINS);
  1377. for j:= 1 to k div wsize do retarea[j]:=pop; retsize:=k;
  1378. newsp(lb); lb:=maxdata+1; { To circumvent stack overflow error }
  1379. newpc(popa);
  1380. if pc=maxcode then
  1381. begin
  1382. halted:=true;
  1383. if retsize=wsize then exitstatus:=retarea[1]
  1384. else exitstatus:=undef
  1385. end
  1386. else
  1387. newlb(popa);
  1388. end;
  1389. LFR: begin k:=args(k); if k<>retsize then trap(EILLINS);
  1390. for j:=k div wsize downto 1 do push(retarea[j]);
  1391. end
  1392. end
  1393. end;
  1394. procedure miscops;
  1395. var i,j:integer;
  1396. begin
  1397. case insr of
  1398. { MISCELLANEOUS GROUP }
  1399. ASP,ASS:
  1400. begin if insr=ASS then
  1401. begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=popsw end;
  1402. k:=argf(k);
  1403. if k<0
  1404. then for j:= 1 to -k div wsize do push(undef)
  1405. else newsp(sp+k);
  1406. end;
  1407. BLM,BLS:
  1408. begin if insr=BLS then
  1409. begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
  1410. k:=argz(k);
  1411. b:=popa; a:=popa;
  1412. for j := 1 to k div wsize do
  1413. store(b-wsize+wsize*j,memw(a-wsize+wsize*j))
  1414. end;
  1415. CSA: begin k:=argw(k); if k<>wsize then trap(EILLINS);
  1416. a:=popa;
  1417. st:= popsw - signwd(memw(a+asize));
  1418. if (st>=0) and (st<=memw(a+wsize+asize)) then
  1419. b:=mema(a+2*wsize+asize+asize*st) else b:=mema(a);
  1420. if b=0 then trap(ECASE) else newpc(b)
  1421. end;
  1422. CSB: begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
  1423. t:=pop; i:=1; found:=false;
  1424. while (i<=memw(a+asize)) and not found do
  1425. if t=memw(a+(asize+wsize)*i) then found:=true else i:=i+1;
  1426. if found then b:=memw(a+(asize+wsize)*i+wsize) else b:=memw(a);
  1427. if b=0 then trap(ECASE) else newpc(b);
  1428. end;
  1429. DCH: begin pusha(mema(popa+dynd)) end;
  1430. DUP,DUS:
  1431. begin if insr=DUS then
  1432. begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
  1433. k:=args(k);
  1434. for i:=1 to k div wsize do push(memw(sp+k-wsize));
  1435. end;
  1436. EXG: begin
  1437. k:=argw(k);
  1438. for i:=1 to k div wsize do push(memw(sp+k-wsize));
  1439. for i:=0 to k div wsize - 1 do
  1440. store(sp+k+i*wsize,memw(sp+k+k+i*wsize));
  1441. for i:=1 to k div wsize do
  1442. begin t:=pop ; store(sp+k+k-wsize,t) end;
  1443. end;
  1444. FIL: filna(argg(k));
  1445. GTO: begin k:=argg(k);
  1446. newlb(mema(k+2*asize)); newsp(mema(k+asize)); newpc(mema(k))
  1447. end;
  1448. LIM: push(ignmask);
  1449. LIN: lino(argn(k));
  1450. LNI: lino(memw(0)+1);
  1451. LOR: begin i:=argr(k);
  1452. case i of 0:pusha(lb); 1:pusha(sp); 2:pusha(hp) end;
  1453. end;
  1454. LPB: pusha(popa+statd);
  1455. MON: domon(pop);
  1456. NOP: writeln('NOP at line ',memw(0):5) ;
  1457. RCK: begin a:=popa;
  1458. case szindex(argw(k)) of
  1459. 1: if (signwd(memw(sp))<signwd(memw(a))) or
  1460. (signwd(memw(sp))>signwd(memw(a+wsize))) then trap(ERANGE);
  1461. 2: if (memd(sp)<memd(a)) or
  1462. (memd(sp)>memd(a+2*wsize)) then trap(ERANGE);
  1463. end
  1464. end;
  1465. RTT: dortt;
  1466. SIG: begin a:=popa; pusha(uerrorproc); uerrorproc:=a end;
  1467. SIM: ignmask:=pop;
  1468. STR: begin i:=argr(k);
  1469. case i of 0: newlb(popa); 1: newsp(popa); 2: newhp(popa) end;
  1470. end;
  1471. TRP: trap(pop)
  1472. end
  1473. end;
  1474. {
  1475. .bp
  1476. {---------------------------------------------------------------------------}
  1477. { Main Loop }
  1478. {---------------------------------------------------------------------------}
  1479. begin initialize;
  1480. 8888:
  1481. repeat
  1482. opcode := nextpc; { fetch the first byte of the instruction }
  1483. if opcode=escape1 then iclass:=second
  1484. else if opcode=escape2 then iclass:=tert
  1485. else iclass:=prim;
  1486. if iclass<>prim then opcode := nextpc;
  1487. with dispat[iclass][opcode] do
  1488. begin insr:=instr;
  1489. if not (zbit in iflag) then
  1490. if ibit in iflag then k:=pop else
  1491. begin
  1492. if mini in iflag then k:=implicit else
  1493. begin
  1494. if short in iflag then k:=implicit+nextpc else
  1495. begin k:=nextpc;
  1496. if (sbit in iflag) and (k>=128) then k:=k-256;
  1497. for i:=2 to ilength do k:=256*k + nextpc
  1498. end
  1499. end;
  1500. if wbit in iflag then k:=k*wsize;
  1501. end
  1502. end;
  1503. case insr of
  1504. NON: trap(EILLINS);
  1505. { LOAD GROUP }
  1506. LDC,LOC,LOL,LOE,LIL,LOF,LAL,LAE,LXL,LXA,LOI,LOS,LDL,LDE,LDF,LPI:
  1507. loadops;
  1508. { STORE GROUP }
  1509. STL,STE,SIL,STF,STI,STS,SDL,SDE,SDF:
  1510. storeops;
  1511. { SIGNED INTEGER ARITHMETIC }
  1512. ADI,SBI,MLI,DVI,RMI,NGI,SLI,SRI:
  1513. intarith;
  1514. { UNSIGNED INTEGER ARITHMETIC }
  1515. ADU,SBU,MLU,DVU,RMU,SLU,SRU:
  1516. unsarith;
  1517. { FLOATING POINT ARITHMETIC }
  1518. ADF,SBF,MLF,DVF,NGF,FIF,FEF:
  1519. fltarith;
  1520. { POINTER ARITHMETIC }
  1521. ADP,ADS,SBS:
  1522. ptrarith;
  1523. { INCREMENT/DECREMENT/ZERO }
  1524. INC,INL,INE,DEC,DEL,DEE,ZRL,ZRE,ZER,ZRF:
  1525. incops;
  1526. { CONVERT GROUP }
  1527. CII,CIU,CIF,CUI,CUU,CUF,CFI,CFU,CFF:
  1528. convops;
  1529. { LOGICAL GROUP }
  1530. XAND,IOR,XOR,COM,ROL,ROR:
  1531. logops;
  1532. { SET GROUP }
  1533. INN,XSET:
  1534. setops;
  1535. { ARRAY GROUP }
  1536. LAR,SAR,AAR:
  1537. arrops;
  1538. { COMPARE GROUP }
  1539. CMI,CMU,CMP,CMF,CMS, TLT,TLE,TEQ,TNE,TGE,TGT:
  1540. cmpops;
  1541. { BRANCH GROUP }
  1542. BRA, BLT,BLE,BEQ,BNE,BGE,BGT, ZLT,ZLE,ZEQ,ZNE,ZGE,ZGT:
  1543. branchops;
  1544. { PROCEDURE CALL GROUP }
  1545. CAL,CAI,RET,LFR:
  1546. callops;
  1547. { MISCELLANEOUS GROUP }
  1548. ASP,ASS,BLM,BLS,CSA,CSB,DCH,DUP,DUS,EXG,FIL,GTO,LIM,
  1549. LIN,LNI,LOR,LPB,MON,NOP,RCK,RTT,SIG,SIM,STR,TRP:
  1550. miscops;
  1551. end; { end of case statement }
  1552. if not ( (insr=RET) or (insr=ASP) or (insr=BRA) or (insr=GTO) ) then
  1553. retsize:=0 ;
  1554. until halted;
  1555. 9999:
  1556. writeln('halt with exit status: ',exitstatus:1);
  1557. doident;
  1558. end.