【转】 接上pl0-分析

【转】 接上pl0-分析
2011年11月23日
　　(* 条件处理过程condition *)
　　(* 参数说明：fsys: 如果出错可用来恢复语法分析的符号集合 *)
　　procedure condition(fsys: symset);
　　var 
　　relop: symbol; (* 用于临时记录token(这里一定是一个二元逻辑运算符)的内容 *)
　　begin
　　if sym = oddsym then (* 如果是odd运算符(一元) *)
　　begin
　　getsym; (* 获取下一个token *)
　　expression(fsys); (* 对odd的表达式进行处理计算 *)
　　gen(opr, 0, 6); (* 生成6号操作指令：奇偶判断运算 *)
　　end
　　else (* 如果不是odd运算符(那就一定是二元逻辑运算符) *)
　　begin
　　expression([eql, neq, lss, leq, gtr, geq] + fsys); (* 对表达式左部进行处理计算 *)
　　if not (sym in [eql, neq, lss, leq, gtr, geq]) then (* 如果token不是逻辑运算符中的一个 *)
　　error(20) (* 抛出20号错误 *)
　　else
　　begin
　　relop := sym; (* 记录下当前的逻辑运算符 *)
　　getsym; (* 获取下一个token *)
　　expression(fsys); (* 对表达式右部进行处理计算 *)
　　case relop of (* 如果刚才的运算符是下面的一种 *)
　　eql: gen(opr, 0,; (* 等号：产生8号判等指令 *)
　　neq: gen(opr, 0, 9); (* 不等号：产生9号判不等指令 *)
　　lss: gen(opr, 0, 10); (* 小于号：产生10号判小指令 *)
　　geq: gen(opr, 0, 11); (* 大于等号号：产生11号判不小于指令 *)
　　gtr: gen(opr, 0, 12); (* 大于号：产生12号判大于指令 *)
　　leq: gen(opr, 0, 13); (* 小于等于号：产生13号判不大于指令 *)
　　end
　　end
　　end
　　end (* condition *);
　　begin (* statement *)
　　if sym = ident then (* 所谓"语句"可能是赋值语句，以标识符开头 *)
　　begin
　　i := position(id); (* 在符号表中查到该标识符所在位置 *)
　　if i = 0 then (* 如果没找到 *)
　　error(11) (* 抛出11号错误 *)
　　else
　　if table[i].kind  variable then (* 如果在符号表中找到该标识符，但该标识符不是变量名 *) 
　　begin
　　error(12); (* 抛出12号错误 *)
　　i := 0 (* i置0作为错误标志 *)
　　end;
　　getsym; (* 获得下一个token，正常应为赋值号 *)
　　if sym = becomes then (* 如果的确为赋值号 *)
　　getsym (* 获取下一个token，正常应为一个表达式 *)
　　else
　　error(13); (* 如果赋值语句的左部标识符号后所接不是赋值号，抛出13号错误 *)
　　expression(fsys); (* 处理表达式 *)
　　if i  0 then (* 如果不曾出错，i将不为0，i所指为当前语名左部标识符在符号表中的位置 *)
　　with table[i] do
　　gen(sto, lev - level, adr) (* 产生一行把表达式值写往指定内存的sto目标代码 *)
　　end
　　else
　　if sym = readsym then (* 如果不是赋值语句，而是遇到了read语句 *)
　　begin
　　getsym; (* 获得下一token，正常情况下应为左括号 *)
　　if sym  lparen then (* 如果read语句后跟的不是左括号 *)
　　error(34) (* 抛出34号错误 *)
　　else
　　repeat (* 循环得到read语句括号中的参数表，依次产生相应的"从键盘读入"目标代码 *)
　　getsym; (* 获得一个token，正常应是一个变量名 *)
　　if sym = ident then (* 如果确为一个标识符 *) 
　　(* 这里略有问题，还应判断一下这个标识符是不是变量名，如果是常量名或过程名应出错 *)
　　i := position(id) (* 查符号表，找到它所在位置给i，找不到时i会为0 *)
　　else
　　i := 0; (* 不是标识符则有问题，i置0作为出错标志 *)
　　if i = 0 then (* 如果有错误 *)
　　error(35) (* 抛出35号错误 *)
　　else (* 否则生成相应的目标代码 *)
　　with table[i] do
　　begin
　　gen(opr, 0, 16); (* 生成16号操作指令:从键盘读入数字 *)
　　gen(sto, lev - level, adr) (* 生成sto指令，把读入的值存入指定变量所在的空间 *)
　　end;
　　getsym (* 获取下一个token，如果是逗号，则read语还没完，否则应当是右括号 *)
　　until sym  comma; (* 不断生成代码直到read语句的参数表中的变量遍历完为止，这里遇到不是逗号，应为右括号 *)
　　if sym  rparen then (* 如果不是我们预想中的右括号 *)
　　begin
　　error(33); (* 抛出33号错误 *)
　　while not (sym in fsys) do (* 依靠fsys集，找到下一个合法的token，恢复语法分析 *)
　　getsym
　　end
　　else
　　getsym (* 如果read语句正常结束，得到下一个token，一般为分号或end *)
　　end
　　else
　　if sym = writesym then (* 如果遇到了write语句 *)
　　begin
　　getsym; (* 获取下一token，应为左括号 *)
　　if sym = lparen then (* 如确为左括号 *)
　　begin
　　repeat (* 依次获取括号中的每一个值，进行输出 *)
　　getsym; (* 获得一个token，这里应是一个标识符 *)
　　expression([rparen, comma] + fsys); (* 调用expression过程分析表达式，用于出错恢复的集合中加上右括号和逗号 *)
　　gen(opr, 0, 14) (* 生成14号指令：向屏幕输出 *)
　　until sym  comma; (* 循环直到遇到的不再是逗号，这时应是右括号 *)
　　if sym  rparen then (* 如果不是右括号 *)
　　error(33) (* 抛出33号错误 *)
　　else
　　getsym (* 正常情况下要获取下一个token，为后面准备好 *)
　　end;
　　gen(opr, 0, 15) (* 生成一个15号操作的目标代码，功能是输出一个换行 *)
　　(* 由此可知PL/0中的write语句与Pascal中的writeln语句类似，是带有输出换行的 *)
　　end
　　else
　　if sym = callsym then (* 如果是call语句 *)
　　begin
　　getsym; (* 获取token，应是过程名型标识符 *)
　　if sym  ident then (* 如果call后跟的不是标识符 *)
　　error(14) (* 抛出14号错误 *)
　　else
　　begin
　　i := position(id); (* 从符号表中找出相应的标识符 *)
　　if i = 0 then (* 如果没找到 *)
　　error(11) (* 抛出11号错误 *)
　　else
　　with table[i] do (* 如果找到标识符位于符号表第i位置 *)
　　if kind = procedur then (* 如果这个标识符为一个过程名 *)
　　gen(cal,lev-level,adr) (* 生成cal目标代码，呼叫这个过程 *)
　　else
　　error(15); (* 如果call后跟的不是过程名，抛出15号错误 *)
　　getsym (* 获取下一token，为后面作准备 *)
　　end
　　end
　　else
　　if sym = ifsym then (* 如果是if语句 *)
　　begin
　　getsym; (* 获取一token应是一个逻辑表达式 *)
　　condition([thensym, dosym] + fsys); (* 对逻辑表达式进行分析计算，出错恢复集中加入then和do语句 *)
　　if sym = thensym then (* 表达式后应遇到then语句 *)
　　getsym (* 获取then后的token，应是一语句 *)
　　else
　　error(16); (* 如果if后没有then，抛出16号错误 *)
　　cx1 := cx; (* 记下当前代码分配指针位置 *)
　　gen(jpc, 0, 0); (* 生成条件跳转指令，跳转位置暂时填0，分析完语句后再填写 *)
　　statement(fsys); (* 分析then后的语句 *)
　　code[cx1].a:=cx (* 上一行指令(cx1所指的)的跳转位置应为当前cx所指位置 *)
　　end
　　else
　　if sym = beginsym then (* 如果遇到begin *)
　　begin
　　getsym; (* 获取下一个token *)
　　statement([semicolon, endsym] + fsys);(* 对begin与end之间的语句进行分析处理 *)
　　while sym in [semicolon] + statbegsys do (* 如果分析完一句后遇到分号或语句开始符循环分析下一句语句 *)
　　begin
　　if sym = semicolon then (* 如果语句是分号（可能是空语句） *)
　　getsym (* 获取下一token继续分析 *)
　　else
　　error(10); (* 如果语句与语句间没有分号，出10号错 *)
　　statement([semicolon, endsym] + fsys) (* 分析一个语句 *)
　　end;
　　if sym = endsym then (* 如果语句全分析完了，应该遇到end *)
　　getsym (* 的确是end，读下一token *)
　　else
　　error(17) (* 如果不是end，抛出17号错 *)
　　end
　　else
　　if sym = whilesym then (* 如果遇到while语句 *)
　　begin
　　cx1 := cx; (* 记下当前代码分配位置，这是while循环的开始位置 *)
　　getsym; (* 获取下一token，应为一逻辑表达式 *)
　　condition([dosym] + fsys); (* 对这个逻辑表达式进行分析计算 *)
　　cx2 := cx; (* 记下当前代码分配位置，这是while的do中的语句的开始位置 *)
　　gen(jpc, 0, 0); (* 生成条件跳转指令，跳转位置暂时填0 *)
　　if sym = dosym then (* 逻辑表达式后应为do语句 *)
　　getsym (* 获取下一token *)
　　else
　　error(18); (* if后缺少then，抛出18号错误 *)
　　statement(fsys); (* 分析do后的语句块 *)
　　gen(jmp, 0, cx1); (* 循环跳转到cx1位置，即再次进行逻辑判断 *)
　　code[cx2].a := cx (* 把刚才填0的跳转位置改成当前位置，完成while语句的处理 *)
　　end;
　　test(fsys, [], 19) (* 至此一个语句处理完成，一定会遇到fsys集中的符号，如果没有遇到，就抛19号错 *)
　　end(* statement *);
　　begin (* block *)
　　dx := 3; (* 地址指示器给出每层局部量当前已分配到的相对位置。
　　置初始值为3的原因是：每一层最开始的位置有三个空间用于存放静态链SL、动态链DL和返回地址RA *)
　　tx0 := tx; (* 初始符号表指针指向当前层的符号在符号表中的开始位置 *)
　　table[tx].adr := cx; (* 符号表当前位置记下当前层代码的开始位置 *)
　　gen(jmp, 0, 0); (* 产生一行跳转指令，跳转位置暂时未知填0 *)
　　if lev > levmax then (* 如果当前过程嵌套层数大于最大允许的套层数 *)
　　error(32); (* 发出32号错误 *)
　　repeat (* 开始循环处理源程序中所有的声明部分 *)
　　if sym = constsym then (* 如果当前token是const保留字，开始进行常量声明 *)
　　begin
　　getsym; (* 获取下一个token，正常应为用作常量名的标识符 *)
　　repeat (* 反复进行常量声明 *)
　　constdeclaration; (* 声明以当前token为标识符的常量 *)
　　while sym = comma do (* 如果遇到了逗号则反复声明下一个常量 *)
　　begin
　　getsym; (* 获取下一个token，这里正好应该是标识符 *)
　　constdeclaration (* 声明以当前token为标识符的常量 *)
　　end;
　　if sym = semicolon then (* 如果常量声明结束，应遇到分号 *)
　　getsym (* 获取下一个token，为下一轮循环做好准备 *)
　　else
　　error(5) (* 如果常量声明语句结束后没有遇到分号则发出5号错误 *)
　　until sym  ident (* 如果遇到非标识符，则常量声明结束 *)
　　end;
　　(* 此处的常量声明的语法与课本上的EBNF范式有不同之处：
　　它可以接受像下面的声明方法，而根据课本上的EBNF范式不可得出下面的语法：
　　const a = 3, b = 3; c = 6; d = 7, e = 8; 
　　即它可以接受分号或逗号隔开的常量声明，而根据EBNF范式只可接受用逗号隔开的声明 *)
　　if sym = varsym then (* 如果当前token是var保留字，开始进行变量声明,与常量声明类似 *)
　　begin
　　getsym; (* 获取下一个token，此处正常应为用作变量名的一个标识符 *)
　　repeat (* 反复进行变量声明 *)
　　vardeclaration; (* 以当前token为标识符声明一个变量 *)
　　while sym = comma do (* 如果遇到了逗号则反复声明下一个变量 *)
　　begin
　　getsym; (* 获取下一个token，这里正好应该是标识符 *)
　　vardeclaration; (* 声明以当前token为标识符的变量 *)
　　end;
　　if sym = semicolon then (* 如果变量声明结束，应遇到分号 *)
　　getsym (* 获取下一个token，为下一轮循环做好准备 *)
　　else
　　error(5) (* 如果变量声明语句结束后没有遇到分号则发出5号错误 *)
　　until sym  ident; (* 如果遇到非标识符，则变量声明结束 *)
　　(* 这里也存在与上面的常量声明一样的毛病：与PL/0的语法规范有冲突。 *)
　　end;
　　while sym = procsym do (* 循环声明各子过程 *)
　　begin
　　getsym; (* 获取下一个token，此处正常应为作为过程名的标识符 *)
　　if sym = ident then (* 如果token确为标识符 *)
　　begin
　　enter(procedur); (* 把这个过程登录到名字表中 *)
　　getsym (* 获取下一个token，正常情况应为分号 *)
　　end
　　else
　　error(4); (* 否则抛出4号错误 *)
　　if sym = semicolon then (* 如果当前token为分号 *)
　　getsym (* 获取下一个token，准备进行语法分析的递归调用 *)
　　else
　　error(5); (* 否则抛出5号错误 *)
　　block(lev + 1, tx, [semicolon] + fsys); (* 递归调用语法分析过程，当前层次加一，同时传递表头索引、合法单词符 *)
　　if sym = semicolon then (* 递归返回后当前token应为递归调用时的最后一个end后的分号 *)
　　begin
　　getsym; (* 获取下一个token *)
　　test(statbegsys + [ident, procsym], fsys, 6); (* 检查当前token是否合法，不合法则用fsys恢复语法分析同时抛6号错 *)
　　end
　　else
　　error(5) (* 如果过程声明后的符号不是分号，抛出5号错误 *)
　　end;
　　test(statbegsys + [ident], declbegsys, 7) (* 检查当前状态是否合法，不合法则用声明开始符号作出错恢复、抛7号错 *)
　　until not (sym in declbegsys); (* 直到声明性的源程序分析完毕，继续向下执行，分析主程序 *)
　　code[table[tx0].adr].a := cx; (* 把前面生成的跳转语句的跳转位置改成当前位置 *)
　　with table[tx0] do (* 在符号表中记录 *)
　　begin
　　adr := cx; (* 地址为当前代码分配地址 *)
　　size := dx; (* 长度为当前数据代分配位置 *)
　　end;
　　cx0 := cx; (* 记下当前代码分配位置 *)
　　gen(int, 0, dx); (* 生成分配空间指令，分配dx个空间 *)
　　statement([semicolon, endsym] + fsys); (* 处理当前遇到的语句或语句块 *)
　　gen(opr, 0, 0); (* 生成从子程序返回操作指令 *)
　　test(fsys, [],; (* 用fsys检查当前状态是否合法，不合法则抛8号错 *)
　　listcode (* 列出本层的类PCODE代码 *)
　　end(* block *);
　　(* PL/0编译器产生的类PCODE目标代码解释运行过程interpret *)
　　procedure interpret;
　　const 
　　stacksize = 500; (* 常量定义，假想的栈式计算机有500个栈单元 *)
　　var 
　　p, b, t: integer; (* program base topstack registers *) 
　　(* p为程序指令指针，指向下一条要运行的代码 *)
　　(* b为基址指针，指向每个过程被调用时数据区中分配给它的局部变量数据段基址 *)
　　(* t为栈顶寄存器，类PCODE是在一种假想的栈式计算上运行的，这个变量记录这个计算机的当前栈顶位置 *)
　　i: instruction; (* i变量中存放当前在运行的指令 *)
　　s: array[1..stacksize] of integer; (* datastore *) (* s为栈式计算机的数据内存区 *)
　　(* 通过静态链求出数据区基地址的函数base *)
　　(* 参数说明：l:要求的数据区所在层与当前层的层差 *)
　　(* 返回值：要求的数据区基址 *)
　　function base(l: integer): integer;
　　var 
　　b1: integer;
　　begin
　　b1 := b; (* find base 1 level down *) (* 首先从当前层开始 *)
　　while l > 0 do (* 如果l大于0，循环通过静态链往前找需要的数据区基址 *)
　　begin
　　b1 := s[b1]; (* 用当前层数据区基址中的内容（正好是静态链SL数据，为上一层的基址）的作为新的当前层，即向上找了一层 *)
　　l := l - 1 (* 向上了一层，l减一 *)
　　end;
　　base := b1 (* 把找到的要求的数据区基址返回 *)
　　end(* base *);
　　begin
　　writeln('start pl0'); (* PL/0程序开始运行 *)
　　t := 0; (* 程序开始运行时栈顶寄存器置0 *)
　　b := 1; (* 数据段基址为1 *)
　　p := 0; (* 从0号代码开始执行程序 *)
　　s[1] := 0; 
　　s[2] := 0;
　　s[3] := 0; (* 数据内存中为SL,DL,RA三个单元均为0，标识为主程序 *)
　　repeat (* 开始依次运行程序目标代码 *)
　　i := code[p]; (* 获取一行目标代码 *)
　　p := p + 1; (* 指令指针加一，指向下一条代码 *)
　　with i do 
　　case f of (* 如果i的f，即指令助记符是下面的某种情况，执行不同的功能 *)
　　lit: (* 如果是lit指令 *)
　　begin
　　t := t + 1; (* 栈顶指针上移，在栈中分配了一个单元 *)
　　s[t] := a (* 该单元的内容存放i指令的a操作数，即实现了把常量值放到运行栈栈顶 *)
　　end;
　　opr: (* 如果是opr指令 *)
　　case a of (* operator *) (* 根据a操作数不同，执行不同的操作 *)
　　0: (* 0号操作为从子过程返回操作 *)
　　begin (* return *)
　　t := b - 1; (* 释放这段子过程占用的数据内存空间 *)
　　p := s[t + 3]; (* 把指令指针取到RA的值，指向的是返回地址 *)
　　b := s[t + 2] (* 把数据段基址取到DL的值，指向调用前子过程的数据段基址 *)
　　end;
　　1: (* 1号操作为栈顶数据取反操作 *)
　　s[t] := -s[t]; (* 对栈顶数据进行取反 *)
　　2: (* 2号操作为栈顶两个数据加法操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *) 
　　s[t] := s[t] + s[t + 1] (* 把两单元数据相加存入栈顶 *)
　　end;
　　3: (* 3号操作为栈顶两个数据减法操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *) 
　　s[t] := s[t] - s[t + 1] (* 把两单元数据相减存入栈顶 *)
　　end;
　　4: (* 4号操作为栈顶两个数据乘法操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := s[t] * s[t + 1] (* 把两单元数据相乘存入栈顶 *)
　　end;
　　5: (* 5号操作为栈顶两个数据除法操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := s[t] div s[t + 1] (* 把两单元数据相整除存入栈顶 *)
　　end;
　　6: (* 6号操作为判奇操作 *)
　　s[t] := ord(odd(s[t])); (* 数据栈顶的值是奇数则把栈顶值置1，否则置0 *)
　　8: (* 8号操作为栈顶两个数据判等操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := ord(s[t] = s[t + 1]) (* 判等，相等栈顶置1，不等置0 *)
　　end;
　　9: (* 9号操作为栈顶两个数据判不等操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := ord(s[t]  s[t + 1]) (* 判不等，不等栈顶置1，相等置0 *)
　　end;
　　10: (* 10号操作为栈顶两个数据判小于操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := ord(s[t] = s[t + 1]) (* 判大于等于，如果下面的值大于等于上面的值，栈顶置1，否则置0 *)
　　end;
　　12: (* 12号操作为栈顶两个数据判大于操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := ord(s[t] > s[t + 1]) (* 判大于，如果下面的值大于上面的值，栈顶置1，否则置0 *)
　　end;
　　13: (* 13号操作为栈顶两个数据判小于等于操作 *)
　　begin
　　t := t - 1; (* 栈顶指针下移 *)
　　s[t] := ord(s[t] <= s[t + 1]) (* 判小于等于，如果下面的值小于等于上面的值，栈顶置1，否则置0 *)
　　end;
　　14: (* 14号操作为输出栈顶值操作 *)
　　begin
　　write(s[t]); (* 输出栈顶值 *)
　　write(fa2, s[t]); (* 同时打印到文件 *)
　　t := t - 1 (* 栈顶下移 *)
　　end;
　　15: (* 15号操作为输出换行操作 *)
　　begin
　　writeln; (* 输出换行 *)
　　writeln(fa2) (* 同时输出到文件 *)
　　end;
　　16: (* 16号操作是接受键盘值输入到栈顶 *)
　　begin
　　t := t + 1; (* 栈顶上移，分配空间 *)
　　write('?'); (* 屏显问号 *)
　　write(fa2, '?'); (* 同时输出到文件 *)
　　readln(s[t]); (* 获得输入 *)
　　writeln(fa2, s[t]); (* 把用户输入值打印到文件 *)
　　end;
　　end; (* opr指令分析运行结束 *)
　　lod: (* 如果是lod指令:将变量放到栈顶 *)
　　begin
　　t := t + 1; (* 栈顶上移，开辟空间 *)
　　s[t] := s[base(l) + a] (* 通过数据区层差l和偏移地址a找到变量的数据，存入上面开辟的新空间（即栈顶） *)
　　end;
　　sto: (* 如果是sto指令 *)
　　begin
　　s[base(l) + a] := s[t]; (* 把栈顶的值存入位置在数据区层差l偏移地址a的变量内存 *)
　　t := t - 1 (* 栈项下移，释放空间 *)
　　end;
　　cal: (* 如果是cal指令 *)
　　begin (* generat new block mark *)
　　s[t + 1] := base(l); (* 在栈顶压入静态链SL *)
　　s[t + 2] := b; (* 然后压入当前数据区基址，作为动态链DL *)
　　s[t + 3] := p; (* 最后压入当前的断点，作为返回地址RA *)
　　(* 以上的工作即为过程调用前的保护现场 *)
　　b := t + 1; (* 把当前数据区基址指向SL所在位置 *)
　　p := a; (* 从a所指位置开始继续执行指令，即实现了程序执行的跳转 *)
　　end;
　　int: (* 如果是int指令 *)
　　t := t + a; (* 栈顶上移a个空间，即开辟a个新的内存单元 *)
　　jmp: (* 如果是jmp指令 *)
　　p := a; (* 把jmp指令操作数a的值作为下一次要执行的指令地址，实现无条件跳转 *)
　　jpc: (* 如果是jpc指令 *)
　　begin
　　if s[t] = 0 then (* 判断栈顶值 *)
　　p := a; (* 如果是0就跳转，否则不跳转 *)
　　t := t - 1 (* 释放栈顶空间 *)
　　end;
　　end(* with,case *)
　　until p = 0; (* 如果p等于0，意味着在主程序运行时遇到了从子程序返回指令，也就是整个程序运行的结束 *)
　　close(fa2) (* 关闭用于记录屏幕输入输出的fa2文件 *)
　　(* PCODE代码的解释执行过程结束 *)
　　end(* interpret *);