{$Apptype console}
program pl0(fa,fa1,fa2); (* PL/0編譯程序與代碼生成解釋運行程序 *)
(* PL/0 compiler with code generation *)
label 99; (* 聲明出錯跳轉標記 *)
(* 在Turbo Pascal 7.0中已不允許跨過程的GOTO轉移，因此后面的GOTO語句均被我去除了，因此這里的label也沒有意義了 *)
const (* 常量定義 *)
? norw = 13;???? (* of reserved words *) (* 保留字的個數 *)
? txmax = 100;?? (* length of identifier table *) (* 標識符表的長度（容量） *)
? nmax = 14;???? (* max number of digits in numbers *) (* 數字允許的最長位數 *)
? al = 10;?????? (* length of identifiers *) (* 標識符最長長度 *)
? amax = 2047;?? (* maximum address *) (* 尋址空間 *)
? levmax = 3;??? (* max depth of block nesting *) (* 最大允許的塊嵌套層數 *)
? cxmax = 200;?? (* size of code array *) (* 類PCODE目標代碼數組長度（可容納代碼行數） *)
type (* 類型定義 *)
? symbol = (nul, ident, number, plus, minus, times, slash, oddsym,
??????????? eql, neq, lss, leq, gtr, geq, lparen, rparen, comma,
??????????? semicolon, period, becomes, beginsym, endsym, ifsym,
??????????? thensym, whilesym, writesym, readsym, dosym, callsym,
??????????? constsym, varsym, procsym); (* symobl類型標識了不同類型的詞匯 *)
? alfa = packed array[1..al] of char; (* alfa類型用于標識符 *)
? object1 = (constant, variable, procedur); (* object1為三種標識符的類型 *)
? (* 原程序在此使用object作為類型名稱，在支持面向對象的Turbo Pascal 7.0中編譯不能通過 *)
? (* wirth used the word "procedure" there, whick won't work! *)
? (* 上面一行是課本上的程序清單中的注釋，說本程序的原作者Wirth在這里用了procedure這個詞作為標識符類型，是不可以的。
???? 事實上Wirth原本在這里用的詞是prozedure，是可以的。 *)
? symset = set of symbol; (* symset是symbol類型的一個集合類型，可用于存放一組symbol *)
? fct = (lit, opr, lod, sto, cal, int, jmp, jpc); (* fct類型分別標識類PCODE的各條指令 *)
? instruction = packed record
??? f: fct;?????? (* function code *)
??? l: 0..levmax; (* level *)
??? a: 0..amax;?? (* displacement addr *)
? end; (* 類PCODE指令類型，包含三個字段：指令f、層差l和另一個操作數a *)
? (*
???? lit 0, a? load constant a
???? opr 0, a? execute opr a
???? lod l, a? load variable l, a
???? sto l, a? store variable l, a
???? cal l, a? call procedure a at level l
???? int 0, a? increment t-register by a
???? jmp 0, a? jump to a
???? jpc 0, a? jump conditional to a
? *)
var (* 全局變量定義 *)
? fa: text; (* 文本文件fa用于列出源程序 *)
? fa1, fa2: text; (* 文本文件fa1用于列出類PCODE代碼、fa2用于記錄解釋執行類PCODE代碼的過程 *)
? listswitch: boolean; (* true set list object code *) (* 如果本變量置true，程序編譯后將為列出類PCODE代碼，
????????????????????????????????????????????????????????? 否則不列出類PCODE代碼 *)
? ch: char; (* last char read *) (* 主要用于詞法分析器，存放最近一次從文件中讀出的字符 *)
? sym: symbol; (* last symbol read *) (* 詞法分析器輸出結果之用，存放最近一次識別出來的token的類型 *)
? id: alfa;? (* last identifier read *) (* 詞法分析器輸出結果之用，存放最近一次識別出來的標識符的名字 *)
? num: integer; (* last number read *) (* 詞法分析器輸出結果之用，存放最近一次識別出來的數字的值 *)
? cc: integer;? (* character count *) (* 行緩沖區指針 *)
? ll: integer;? (* line length *) (* 行緩沖區長度 *)
? kk: integer;? (* 引入此變量是出于程序性能考慮，見getsym過程注釋 *)
? cx: integer;? (* code allocation index *) (* 代碼分配指針，代碼生成模塊總在cx所指位置生成新的代碼 *)
? line: array[1..81] of char; (* 行緩沖區，用于從文件讀出一行，供詞法分析獲取單詞時之用 *)
? a: alfa; (* 詞法分析器中用于臨時存放正在分析的詞 *)
? code: array[0..cxmax] of instruction; (* 生成的類PCODE代碼表，存放編譯得到的類PCODE代碼 *)
? word: array[1..norw] of alfa; (* 保留字表 *)
? {此時應該將本代碼好好閱讀，將來無論做什么開發，都會用到}
? wsym: array[1..norw] of symbol; (* 保留字表中每一個保留字對應的symbol類型 *)
? ssym: array[' '..'^'] of symbol; (* 一些符號對應的symbol類型表 *)
??? (* wirth uses "array[char]" here *)
? mnemonic: array[fct] of packed array[1..5] of char;(* 類PCODE指令助記符表 *)
? declbegsys, statbegsys, facbegsys: symset; (* 聲明開始、表達式開始和項開始符號集合 *)
? table: array[0..txmax] of record (* 符號表 *)
??? name: alfa; (* 符號的名字 *)
??? case kind: object1 of (* 符號的類型 *)
????? constant: (* 如果是常量名 *)
??????? (val: integer); (* val中放常量的值 *)
????? variable, procedur:? (* 如果是變量名或過程名 *)
??????? (level, adr, size: integer) (* 存放層差、偏移地址和大小 *)
??????? (* "size" lacking in orginal. I think it belons here *)
? end;
? fin, fout: text; (* fin文本文件用于指向輸入的源程序文件，fout程序中沒有用到 *)
? fname: string; (* 存放PL/0源程序文件的文件名 *)
? (* 我修改的代碼：原程序在此處使用alfa類型，無法在Turbo Pascal 7.0中通過，readln函數的參數不能為alfa型 *)
? err: integer; (* 出錯總次數 *)
{*************************************************************************************}
(* 出錯處理過程error *)
(* 參數：n:出錯代碼 *)
procedure error(n: integer);
begin
? writeln('****', ' ': cc-1, '!', n:2); (* 在屏幕cc-1位置顯示!與出錯代碼提示，由于cc
?????????????????????????????????????????? 是行緩沖區指針，所以!所指位置即為出錯位置 *)
? writeln(fa1, '****', ' ': cc-1, '!', n:2); (* 在文件cc-1位置輸出!與出錯代碼提示 *)
? err := err + 1 (* 出錯總次數加一 *)
end (* error *);
{*************************************************************************************}
(* 詞法分析過程getsym *)
procedure getsym;
var
? i, j, k: integer;
? (* 讀取原程序中下一個字符過程getch *)
? procedure getch;
? begin
??? {一次讀取一整行，而取字符時，只從line中取就可以了}
??? if cc = ll then (* 如果行緩沖區指針指向行緩沖區最后一個字符就從文件讀一行到行緩沖區 *)
??? begin
????? if eof(fin) then (* 如果到達文件末尾 *)
????? begin
??????? write('Program incomplete'); (* 出錯，退出程序 *)
??????? close(fa);
??????? close(fa1);
??????? close(fin);
??????? halt(0);???????
??????? {goto 99}
??????? (* 我修改的代碼，由于Turbo Pascal 7.0中不允許跨過程的goto，就只能用上面的方法退出程序了。 *)
????? end;
????? ll := 0; (* 行緩沖區長度置0 *)
????? cc := 0; (* 行緩沖區指針置行首 *)
????? write(cx: 4, ' '); (* 輸出cx值，寬度為4 *)
????? write(fa1, cx: 4, ' '); (* 輸出cx值，寬度為4到文件 *)
????? while not eoln(fin) do (* 當未到行末時 *)
????? begin
??????? ll := ll + 1; (* 行緩沖區長度加一 *)
??????? read(fin, ch); (* 從文件讀入一個字符到 ch *)
??????? write(ch); (* 在屏幕輸出ch *)
??????? write(fa1, ch); (* 把ch輸出到文件 *)
??????? line[ll] := ch; (* 把讀到的字符存入行緩沖區相應的位置 *)
????? end;
????? (* 可見，PL/0源程序要求每行的長度都小于81個字符 *)
????? writeln;
????? ll := ll + 1; (* 行緩沖區長度加一，用于容納即將讀入的回車符CR *)
????? read(fin, line[ll]);(* 把#13(CR)讀入行緩沖區尾部 *)
????? read(fin, ch); (* 我添加的代碼。由于PC上文本文件換行是以#13#10(CR+LF)表示的，
??????????????????????? 所以要把多余的LF從文件讀出，這里放在ch變量中是由于ch變量的
??????????????????????? 值在下面即將被改變，把這個多余值放在ch中沒有問題 *)
????? writeln(fa1);
??? end;
??? cc := cc + 1; (* 行緩沖區指針加一，指向即將讀到的字符 *)
??? ch := line[cc] (* 讀出字符，放入全局變量ch *)
? end (* getch *);
begin (* getsym *)
? while (ch = ' ') or (ch = #13) do (* 我修改的代碼：這句原來是用于讀一個有效的字符
?????????????????????????????????????? (跳過讀出的字符中多余的空格)，但實際上還要跳
?????????????????????????????????????? 過多余的回車 *)
??? getch;
? if ch in ['a'..'z'] then (* 如果讀出的字符是一個字母，說明是保留字或標識符 *)
? begin
??? k := 0; (* 標識符緩沖區指針置0 *)
??? repeat (* 這個循環用于依次讀出源文件中的字符構成標識符 *)
????? if k < al then (* 如果標識符長度沒有超過最大標識符長度(如果超過，就取前面一部分，把多余的拋棄) *)
????? begin
??????? k := k + 1;
??????? a[k] := ch;
????? end;
????? getch (* 讀下一個字符 *)
??? until not (ch in ['a'..'z','0'..'9']); (* 直到讀出的不是字母或數字，由此可知PL/0的標識符構成規則是:
????????????????????????????????????????????? 以字母開頭，后面跟若干個字母或數字 *)
??? if k >= kk then (* 如果當前獲得的標識符長度大于等于kk *)
????? kk := k (* 令kk為當前標識符長度 *)
??? else
????? repeat (* 這個循環用于把標識符緩沖后部沒有填入相應字母或空格的空間用空格補足 *)
??????? a[kk] := ' ';
??????? kk := kk - 1
????? until kk = k;
??? (* 在第一次運行這個過程時，kk的值為al，即最大標識符長度，如果讀到的標識符長度小于kk，
?????? 就把a數組的后部沒有字母的空間用空格補足。
?????? 這時，kk的值就成為a數組前部非空格字符的個數。以后再運行getsym時，如果讀到的標識符長度大于等于kk，
?????? 就把kk的值變成當前標識符的長度。
?????? 這時就不必在后面填空格了，因為它的后面肯定全是空格。反之如果最近讀到的標識符長度小于kk，那就需要從kk位置向前，
?????? 把超過當前標識長度的空間填滿空格。
?????? 以上的這樣一個邏輯，完全是出于程序性能的上考慮。其實完全可以簡單的把a數組中a[k]元素以后的空間不管三七二十一全填空格。
??? *)
??? (* 下面開始二分法查找看讀出的標識符是不是保留字之一 *)
??? id := a; (* 最后讀出標識符等于a *)
??? i := 1; (* i指向第一個保留字 *)
??? j := norw; (* j指向最后一個保留字 *)
??? repeat
????? k := (i + j) div 2; (* k指向中間一個保留字 *)
????? if id <= word[k] then (* 如果當前的標識符小于k所指的保留字 *)
??????? j := k - 1; (* 移動j指針 *)
????? if id >= word[k] then (* 如果當前的標識符大于k所指的保留字 *)
??????? i := k + 1 (* 移動i指針 *)
??? until i > j; (* 循環直到找完保留字表 *)
??? if i - 1 > j then (* 如果i - 1 > j表明在保留字表中找到相應的項，id中存的是保留字 *)
????? sym := wsym[k] (* 找到保留字，把sym置為相應的保留字值 *)
??? else
????? sym := ident (* 未找到保留字，把sym置為ident類型，表示是標識符 *)
? end(* 至此讀出字符為字母即對保留字或標識符的處理結束 *)
? else (* 如果讀出字符不是字母 *)
??? if ch in ['0'..'9'] then (* 如果讀出字符是數字 *)
??? begin (* number *) (* 開始對數字進行處理 *)
????? k := 0; (* 數字位數 *)
????? num := 0; (* 數字置為0 *)
????? sym := number; (* 置sym為number，表示這一次讀到的是數字 *)
????? repeat (* 這個循環依次從源文件中讀出字符，組成數字 *)
??????? num := 10 * num + (ord(ch) - ord('0')); (* num * 10加上最近讀出的字符ASCII減'0'的ASCII得到相應的數值 *)
??????? k := k + 1; (* 數字位數加一 *)
??????? getch
????? until not (ch in ['0'..'9']); (* 直到讀出的字符不是數字為止 *)
????? if k > nmax then (* 如果組成的數字位數大于最大允許的數字位數 *)
??????? error(30) (* 發出30號錯 *)
??? end(* 至此對數字的識別處理結束 *)
??? else
????? if ch = ':' then (* 如果讀出的不字母也不是數字而是冒號 *)
????? begin
??????? getch; (* 再讀一個字符 *)
??????? if ch = '=' then (* 如果讀到的是等號，正好可以與冒號構成賦值號 *)
??????? begin
????????? sym := becomes; (* sym的類型設為賦值號becomes *)
????????? getch (* 再讀出下一個字 *)
??????? end
??????? else
????????? sym := nul; (* 如果不是讀到等號，那單獨的一個冒號就什么也不是 *)
????? end(* 以上完成對賦值號的處理 *)
??? else (* 如果讀到不是字母也不是數字也不是冒號 *)
????? if ch = '<' then (* 如果讀到小于號 *)
????? begin
??????? getch; (* 再讀一個字符 *)
??????? if ch = '=' then (* 如果讀到等號 *)
??????? begin
????????? sym := leq; (* 購成一個小于等于號 *)
????????? getch (* 讀一個字符 *)
??????? end
??????? else (* 如果小于號后不是跟的等號 *)
????????? sym := lss (* 那就是一個單獨的小于號 *)
????? end
????? else (* 如果讀到不是字母也不是數字也不是冒號也不是小于號 *)
??????? if ch = '>' then (* 如果讀到大于號，處理過程類似于處理小于號 *)
??????? begin
????????? getch; (* 再讀一個字符 *)
????????? if ch = '=' then (* 如果讀到等號 *)
????????? begin
??????????? sym := geq; (* 購成一個大于等于號 *)
??????????? getch (* 讀一個字符 *)
????????? end
????????? else (* 如果大于號后不是跟的等號 *)
??????????? sym := gtr (* 那就是一個單獨的大于號 *)
??????? end
??????? else(* 如果讀到不是字母也不是數字也不是冒號也不是小于號也不是大于號 *)
??????? begin (* 那就說明它不是標識符/保留字，也不是復雜的雙字節操作符，應該是一個普通的符號 *)
????????? sym := ssym[ch]; (* 直接成符號表中查到它的類型，賦給sym *)
????????? getch (* 讀下一個字符 *)
??????? end
? (* 整個if語句判斷結束 *)
end (* getsym *);
(* 詞法分析過程getsym總結：從源文件中讀出若干有效字符，組成一個token串，識別它的類型
?? 為保留字/標識符/數字或是其它符號。如果是保留字，把sym置成相應的保留字類型，如果是
?? 標識符，把sym置成ident表示是標識符，于此同時，id變量中存放的即為保留字字符串或標識
?? 符名字。如果是數字，把sym置為number,同時num變量中存放該數字的值。如果是其它的操作符，
?? 則直接把sym置成相應類型。經過本過程后ch變量中存放的是下一個即將被識別的字符 *)
(* 目標代碼生成過程gen *)
(* 參數：x:要生成的一行代碼的助記符 *)
(*?????? y, z:代碼的兩個操作數 *)
(* 本過程用于把生成的目標代碼寫入目標代碼數組，供后面的解釋器解釋執行 *)
procedure gen(x: fct; y, z: integer);
begin
? if cx > cxmax then (* 如果cx>cxmax表示當前生成的代碼行號大于允許的最大代碼行數 *)
? begin
??? write('program too long'); (* 輸出"程序太長"，退出 *)
??? close(fa);
??? close(fa1);
??? close(fin);
??? halt(0)??????
??? {goto 99}
??? (* 我修改的代碼，由于Turbo Pascal 7.0中不允許跨過程的goto，就只能用上面的方法退出程序了。 *)
? end;
? with code[cx] do (* 把代碼寫入目標代碼數組的當前cx所指位置 *)
? begin
??? f := x;
??? l := y;
??? a := z;
? end;
? cx := cx + 1 (* 移動cx指針指向下一個空位 *)
end (* gen *);
(* 測試當前單詞是否合法過程test *)
(* 參數：s1:當語法分析進入或退出某一語法單元時當前單詞符合應屬于的集合 *)
(*?????? s2:在某一出錯狀態下，可恢復語法分析正常工作的補充單詞集合 *)
(*?????? n:出錯信息編號，當當前符號不屬于合法的s1集合時發出的出錯信息 *)

procedure test(s1, s2: symset; n: integer);
begin
? if not (sym in s1) then (* 如果當前符號不在s1中 *)
? begin
??? error(n); (* 發出n號錯誤 *)
??? s1 := s1 + s2; (* 把s2集合補充進s1集合 *)
??? while not (sym in s1) do (* 通過循環找到下一個合法的符號，以恢復語法分析工作 *)
????? getsym
? end
end (* test *);
(* 語法分析過程block *)
(* 參數：lev:這一次語法分析所在的層次 *)
(*?????? tx:符號表指針 *)
(*?????? fsys:用于出錯恢復的單詞集合 *)
procedure block(lev, tx: integer; fsys: symset);
var
? dx: integer; (* data allocation index *) (* 數據段內存分配指針，指向下一個被分配空間在數據段中的偏移位置 *)
? tx0: integer;? (* initial table index *) (* 記錄本層開始時符號表位置 *)
? cx0: integer;? (* initial code index *) (* 記錄本層開始時代碼段分配位置 *)
? (* 登陸符號表過程enter *)
? (* 參數：k:欲登陸到符號表的符號類型 *)
? procedure enter(k: object1);
? begin (* enter object into table *)
??? tx := tx + 1; (* 符號表指針指向一個新的空位 *)
??? with table[tx] do (* 開始登錄 *)
??? begin
????? name := id; (* name是符號的名字，對于標識符，這里就是標識符的名字 *)
????? kind := k; (* 符號類型，可能是常量、變量或過程名 *)
????? case k of (* 根據不同的類型進行不同的操作 *)
??????? constant: (* 如果是常量名 *)
??????? begin
????????? if num > amax then (* 在常量的數值大于允許的最大值的情況下 *)
????????? begin
??????????? error(31); (* 拋出31號錯誤 *)
??????????? num := 0; (* 實際登陸的數字以0代替 *)
????????? end;
????????? val := num (* 如是合法的數值，就登陸到符號表 *)
??????? end;
??????? variable: (* 如果是變量名 *)
??????? begin
????????? level := lev; (* 記下它所屬的層次號 *)
????????? adr := dx; (* 記下它在當前層中的偏移量 *)
????????? dx := dx+1; (* 偏移量自增一，為下一次做好準備 *)
??????? end;
??????? procedur: (* 如果要登陸的是過程名 *)
????????? level := lev (* 記錄下這個過程所在層次 *)
????? end
??? end
? end (* enter *);
? (* 登錄符號過程沒有考慮到重復的定義的問題。如果出現重復定義，則以最后一次的定義為準。 *)
?
? (* 在符號表中查找指定符號所在位置的函數position *)
? (* 參數：id:要找的符號 *)
? (* 返回值：要找的符號在符號表中的位置，如果找不到就返回0 *)
? function position (id: alfa): integer;
? var
??? i: integer;
? begin (* find identifier in table *)
??? table[0].name := id; (* 先把id放入符號表0號位置 *)
??? i := tx; (* 從符號表中當前位置也即最后一個符號開始找 *)
??? while table[i].name <> id do (* 如果當前的符號與要找的不一致 *)
????? i := i - 1; (* 找前面一個 *)
??? position := i (* 返回找到的位置號，如果沒找到則一定正好為0 *)
? end(* position *);
? (* 常量聲明處理過程constdeclaration *)
? procedure constdeclaration;
? begin
??? if sym = ident then (* 常量聲明過程開始遇到的第一個符號必然應為標識符 *)
??? begin
????? getsym; (* 獲取下一個token *)
????? if sym in [eql, becomes] then (* 如果是等號或賦值號 *)
????? begin
??????? if sym = becomes then (* 如果是賦值號(常量生明中應該是等號) *)
????????? error(1); (* 拋出1號錯誤 *)
??????? (* 這里其實自動進行了錯誤糾正使編譯繼續進行，把賦值號當作等號處理 *)
??????? getsym; (* 獲取下一個token，等號或賦值號后應接上數字 *)
??????? if sym = number then (* 如果的確是數字 *)
??????? begin
????????? enter(constant); (* 把這個常量登陸到符號表 *)
????????? getsym (* 獲取下一個token，為后面作準備 *)
??????? end
??????? else
????????? error(2) (* 如果等號后接的不是數字，拋出2號錯誤 *)
????? end
????? else
??????? error(3) (* 如果常量標識符后接的不是等號或賦值號，拋出3號錯誤 *)
??? end
??? else
????? error(4) (* 如果常量聲明過程遇到的第一個符號不為標識符，拋出4號錯誤 *)
? end(* constdeclaration *);
? (* 變量聲明過程vardeclaration *)?
? procedure vardeclaration;
? begin
??? if sym = ident then (* 變量聲明過程開始遇到的第一個符號必然應為標識符 *)
??? begin
????? enter(variable); (* 將標識符登陸到符號表中 *)
????? getsym (* 獲取下一個token，為后面作準備 *)
??? end
??? else
????? error(4) (* 如果變量聲明過程遇到的第一個符號不是標識符，拋出4號錯誤 *)
? end(* vardeclaration *);
? (* 列出當前一層類PCODE目標代碼過程listcode *)
? procedure listcode;
? var
??? i: integer;
? begin (* list code generated for this block *)
??? if listswitch then (* 如果用戶選擇是要列出代碼的情況下才列出代碼 *)
??? begin
????? for i := cx0 to cx - 1 do (* 從當前層代碼開始位置到當前代碼位置-1處，即為本分程序塊 *)
??????? with code[i] do
??????? begin
????????? writeln(i: 4, mnemonic[f]: 5, l: 3, a: 5); (* 顯示出第i行代碼的助記符和L與A操作數 *)
????????? (* 我修改的代碼：原程序此處在輸出i時，沒有指定占4個字符寬度，不美觀也與下面一句不配套。 *)
????????? writeln(fa, i: 4, mnemonic[f]: 5, l: 3, a: 5) (* 同時把屏顯打印到文件 *)
??????? end;
??? end
? end(* listcode *);
? (* 語句處理過程statement *)
? (* 參數說明：fsys: 如果出錯可用來恢復語法分析的符號集合 *)
? procedure statement(fsys: symset);
? var
??? i, cx1, cx2: integer;
??? (* 表達式處理過程expression *)
??? (* 參數說明：fsys: 如果出錯可用來恢復語法分析的符號集合 *)
??? procedure expression(fsys: symset);
??? var
????? addop: symbol;
????? (* 項處理過程term *)
????? (* 參數說明：fsys: 如果出錯可用來恢復語法分析的符號集合 *)
????? procedure term(fsys: symset);
????? var
??????? mulop: symbol;
??????? (* 因子處理過程factor *)
??????? (* 參數說明：fsys: 如果出錯可用來恢復語法分析的符號集合 *)
??????? procedure factor(fsys: symset);
??????? var
????????? i: integer;
??????? begin
????????? test(facbegsys, fsys, 24); (* 開始因子處理前，先檢查當前token是否在facbegsys集合中。 *)
???????????????????????????????????? (* 如果不是合法的token，拋24號錯誤，并通過fsys集恢復使語法處理可以繼續進行 *)????????
????????? while sym in facbegsys do (* 循環處理因子 *)
????????? begin
??????????? if sym = ident then (* 如果遇到的是標識符 *)
??????????? begin
????????????? i := position(id); (* 查符號表，找到當前標識符在符號表中的位置 *)
????????????? if i = 0 then (* 如果查符號表返回為0，表示沒有找到標識符 *)
??????????????? error(11) (* 拋出11號錯誤 *)
????????????? else
??????????????? with table[i] do (* 如果在符號表中找到了當前標識符的位置，開始生成相應代碼 *)
????????????????? case kind of
??????????????????? constant: gen(lit, 0, val); (* 如果這個標識符對應的是常量，值為val，生成lit指令，把val放到棧頂 *)
??????????????????? variable: gen(lod, lev - level, adr); (* 如果標識符是變量名，生成lod指令， *)
????????????????????????????????????????????????????????? (* 把位于距離當前層level的層的偏移地址為adr的變量放到棧頂 *)
??????????????????? procedur: error(21) (* 如果在因子處理中遇到的標識符是過程名，出錯了，拋21號錯 *)
????????????????? end;
????????????? getsym (* 獲取下一token，繼續循環處理 *)
??????????? end
??????????? else
????????????? if sym = number then (* 如果因子處理時遇到數字 *)
????????????? begin
??????????????? if num > amax then (* 如果數字的大小超過允許最大值amax *)
??????????????? begin
????????????????? error(31); (* 拋出31號錯 *)
????????????????? num := 0 (* 把數字按0值處理 *)
??????????????? end;
??????????????? gen(lit, 0, num); (* 生成lit指令，把這個數值字面常量放到棧頂 *)
??????????????? getsym (* 獲取下一token *)
????????????? end
????????????? else
??????????????? if sym = lparen then (* 如果遇到的是左括號 *)
??????????????? begin
????????????????? getsym; (* 獲取一個token *)
????????????????? expression( [rparen] + fsys ); (* 遞歸調用expression子程序分析一個子表達式 *)
????????????????? if sym = rparen then (* 子表達式分析完后，應遇到右括號 *)
??????????????????? getsym (* 如果的確遇到右括號，讀取下一個token *)
????????????????? else
??????????????????? error(22) (* 否則拋出22號錯誤 *)
??????????????? end;
??????????? test(fsys, facbegsys, 23) (* 一個因子處理完畢，遇到的token應在fsys集合中 *)
????????????????????????????????????? (* 如果不是，拋23號錯，并找到下一個因子的開始，使語法分析可以繼續運行下去 *)
????????? end
??????? end(* factor *);
????? begin (* term *)
??????? factor([times, slash] + fsys); (* 每一個項都應該由因子開始，因此調用factor子程序分析因子 *)
??????? while sym in [times, slash] do (* 一個因子后應當遇到乘號或除號 *)
??????? begin
????????? mulop := sym; (* 保存當前運算符 *)
????????? getsym; (* 獲取下一個token *)
????????? factor(fsys + [times, slash]); (* 運算符后應是一個因子，故調factor子程序分析因子 *)
????????? if mulop = times then (* 如果剛才遇到乘號 *)
??????????? gen(opr, 0, 4) (* 生成乘法指令 *)
????????? else
??????????? gen(opr, 0, 5) (* 不是乘號一定是除號，生成除法指令 *)
??????? end
????? end (* term *);
??? begin (* expression *)
????? if sym in [plus, minus] then (* 一個表達式可能會由加號或減號開始，表示正負號 *)
????? begin
??????? addop := sym; (* 把當前的正號或負號保存起來，以便下面生成相應代碼 *)
??????? getsym; (* 獲取一個token *)
??????? term(fsys + [plus, minus]); (* 正負號后面應該是一個項，調term子程序分析 *)
??????? if addop = minus then (* 如果保存下來的符號是負號 *)
????????? gen(opr, 0, 1) (* 生成一條1號操作指令：取反運算 *)
??????? (* 如果不是負號就是正號，不需生成相應的指令 *)
????? end
????? else (* 如果不是由正負號開頭，就應是一個項開頭 *)
??????? term(fsys + [plus, minus]); (* 調用term子程序分析項 *)
????? while sym in [plus, minus] do (* 項后應是加運算或減運算 *)
????? begin
??????? addop := sym; (* 把運算符保存下來 *)
??????? getsym; (* 獲取下一個token，加減運算符后應跟的是一個項 *)
??????? term(fsys + [plus, minus]); (* 調term子程序分析項 *)
??????? if addop = plus then (* 如果項與項之間的運算符是加號 *)
????????? gen(opr, 0, 2) (* 生成2號操作指令：加法 *)
??????? else (* 否則是減法 *)
????????? gen(opr, 0, 3) (* 生成3號操作指令：減法 *)
????? end
??? end (* expression *);
??? (* 條件處理過程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); (* 等號：產生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, [], 8); (* 用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;
??????????? 11: (* 11號操作為棧頂兩個數據判大于等于操作 *)
??????????? 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 *);
begin (* main *)
? for ch := ' ' to '!' do (* 這個循環把ssym數組全部填nul *)
??? ssym[ch] := nul;
? (* changed because of different character set
? note the typos below in the original where
? the alfas were not given the correct space *)
? (* 下面初始化保留字表，保留字長度不到10個字符的，多余位置用空格填充，便于詞法分析時以二分法來查找保留字 *)
? word[1] := 'begin???? ';
? word[2] := 'call????? ';
? word[3] := 'const???? ';
? word[4] := 'do??????? ';
? word[5] := 'end?????? ';
? word[6] := 'if??????? ';
? word[7] := 'odd?????? ';
? word[8] := 'procedure ';
? word[9] := 'read????? ';
? word[10] := 'then????? ';
? word[11] := 'var?????? ';
? word[12] := 'while???? ';
? word[13] := 'write???? ';
? (* 保留字符號列表，在上面的保留字表中找到保留字后可以本表中相應位置該保留字的類型 *)
? wsym[1] := beginsym;
? wsym[2] := callsym;
? wsym[3] := constsym;
? wsym[4] := dosym;
? wsym[5] := endsym;
? wsym[6] := ifsym;
? wsym[7] := oddsym;
? wsym[8] := procsym;
? wsym[9] := readsym;
? wsym[10] := thensym;
? wsym[11] := varsym;
? wsym[12] := whilesym;
? wsym[13] := writesym;
? (* 初始化符號表，把可能出現的符號賦上相應的類型，其余符號由于開始處的循環所賦的類型均為nul *)
? ssym['+'] := plus;
? ssym['-'] := minus;
? ssym['*'] := times;
? ssym['/'] := slash;
? ssym['('] := lparen;
? ssym[')'] := rparen;
? ssym['='] := eql;
? ssym[','] := comma;
? ssym['.'] := period;
? ssym['#'] := neq;
? ssym[';'] := semicolon;
? (* 初始化類PCODE助記符表，這個表主要供輸出類PCODE代碼之用 *)
? mnemonic[lit] := ' lit ';
? mnemonic[opr] := ' opr ';
? mnemonic[lod] := ' lod ';
? mnemonic[sto] := ' sto ';
? mnemonic[cal] := ' cal ';
? mnemonic[int] := ' int ';
? mnemonic[jmp] := ' jmp ';
? mnemonic[jpc] := ' jpc ';
? (* 我修改的代碼：書上此處均為'xxx? '形式，即助記符后兩個空格，通過上網查詢原版程序確認為助詞符前后各一空格。 *)
? (* 這樣改的目的是使后面的輸出結果比較美觀 *)
? declbegsys := [constsym, varsym, procsym];
? statbegsys := [beginsym, callsym, ifsym, whilesym];
? facbegsys := [ident, number, lparen];
? (* page(output) *)
? (* 由于Turbo Pascal 7.0的文本文件處理方法與源程序中使用的方法有很大不同，因此下面的有關文件處理的代碼進行了不少更改。 *)
? assign(fa1, 'fa1.txt'); (* 把文本文件fa1與fa1.txt文件關聯起來，用于輸出生成的類PCODE代碼 *)
? rewrite(fa1); (* 建立并打開fa1.txt文件 *)
? write('input file?? '); (* 提示輸入PL/0源程序名 *)
? write(fa1, 'input file? '); (* 同樣的提示輸出到fa1.txt文件 *)
? readln(fname); (* 獲得鍵盤輸入的文件名 *)
? writeln(fa1, fname); (* 把鍵盤輸入打印到fa1.txt文件 *)
? {openf(fin,fname,'r');}
? assign(fin, fname); (* 把PL/0的源程序文件與fin關聯 *)
? reset(fin); (* 打開fin所關聯的PL/0源程序文件 *)
? write('list object code ?'); (* 提示是否要列出類PCODE代碼 *)
? readln(fname); (* 獲得用戶輸入 *)
? write(fa1, 'list object code ?'); (* 同樣的提示寫到fa1.txt文件中 *)
? listswitch := (fname[1] = 'y'); (* 如果輸入'y'開頭的字符串，把listswitch標志置true，否則為false *)
? err := 0; (* 出錯次數置0 *)
? cc := 0; (* 詞法分析行緩沖區指針置0 *)
? cx := 0; (* 類PCODE代碼表指針置0 *)
? ll := 0; (* 詞法分析行緩沖區長度置0 *)
? ch := ' '; (* 詞法分析當前字符為空格 *)
? kk := al; (* 置kk的值為允許的標識符的最長長度，具體用意見getsym過程注釋 *)
? assign(fa, 'fa.txt'); (* 把fa.txt與fa關聯。fa用于輸出源程序 *)
? rewrite(fa); (* 建立并打開fa.txt *)
? getsym; (* 首次調用詞法分析子程序，獲取源程序的第一個詞（token） *)
? block(0, 0, [period] + declbegsys + statbegsys); (* 開始進行主程序（也就是第一個分程序）的語法分析 *)
? (* 主程序所在層為0層，符號表暫時為空，符號表指針指0號位置 *)
? close(fa); (* 關閉文件 *)
? close(fa1); (* 關閉文件 *)
? if sym <> period then (* 主程序分析結束，應遇到表明程序結束的句號 *)
??? error(9); (* 如果不是句號，出現9號錯誤 *)
? (* 以上可知，一個合法的PL/0源程序應由分程序和句號構成。 *)
? if err = 0 then (* 如果出錯次數為0，可以開始解釋執行編譯產生的代碼 *)
? begin
??? assign(fa2, 'fa2.txt'); (* 把文本文件fa2與fa2.txt文件關聯起來，用于輸出類PCODE代碼運行結果 *)
??? rewrite(fa2); (* 建立并打開fa2文件 *)
??? interpret (* 開始解釋執行類PCODE代碼 *)
? end
? else
??? write('errors in pl/0 program'); (* 如果有錯誤，提示程序有錯誤 *)
? 99: (* 這個標號原來是用于退出程序的，由于Turbo Pascal不支持跨過程的跳轉，因此這里這個標號也沒用了。 *)
? {closef(fin);}
? close(fin); (* 關閉源程序文件 *)
? writeln;
? Readln;
end.

總結

以上是生活随笔為你收集整理的pl0源码（可在delphi7中运行）的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。