IBM 704 в историческом плане очень важная машина. На ней был реализован
первый компилятор языка Фортран. Архитектура машины осталась аккумуляторной,
но появились индексные регистры и аппаратная поддержка вычислений с плавающей
точкой. Для реализации компилятора последнее не нужно, но оно нужно для многого
другого и встроить поддержку соответствующего типа в компилятор скорее всего
несложно.
В качестве основы и для компиляции самого компилятора был использован
Tiny Context для Linux/AMD64. Я думал, что
выполнить перевод будет совсем просто, но это оказалось не так. Компилятор
заработал только после исправления двух десятков ошибок разного рода.
Длина кода получилась чуть больше 7000 команд, 293 перфокарты.
Вопрос о возможности реализации такого проекта с нуля на машине
того времени остался открытым.
Представим себе, что компилятор написан на бумаге, вручную переведен в код,
пробиты перфокарты. Перевод сделан дважды и проверен на совпадение, перфокатры
также проверены. И компилятор не работает. Нужно искать и исправлять ошибки,
часть перфорарт должна быть пробита заново. В коде оставлено немного места в конце
каждой функции, но если места недостаточно или если ошибка допущена в начале
большой функции, можно поместить исправление в конец всего кода и сделать переход/возврат.
Большая часть ошибок простые, а вот функция чтения перфоракты была авантюрой.
Ее надо было писать и проверять до того, как все было сделано, а не после.
Tiny Context поддерживает два числовых типа данных - byte и word, последний
является машинным словом (или удвоенным машиным словом в реализациях
для 8-и разрядных систем). В данном случае это 64-х разрядное беззнаковое целое
и его вполне достаточно для представления 36-и разрядных команд IBM 704.
Но обрабатывать знаковый разряд надо особым образом. По-видимому было бы лучше,
если бы вместо типа word был int, но я решил этого не делать.
А вот поддержка восьмеричных констант очень нужна и она должны быть добавлена
в функцию val() компилятота для Linux по аналогии с поддержкой шестнадцатеричных
констант:
word val () is
word E:=10;
word I:= 0;
if Buff[0]='0' then
if Buff[1]='c' then
E:= 8;
I:= 2;
end
if Buff[1]='x' then
E:=16;
I:= 2;
end
end
...
end
Также было бы желательным наличие операции битового умножения (&),
но было решено обойтись без нее. Это также привело к ошибкам.
Искусственный интеллект использовался и он кое-что дал для понимания системы
команд IBM 704 и предупредил об особенности работы со знаками чисел. Я предупреждение
недооценил и это привело к ошибке и ее длительному поиску.
Первоначально при создании кода для операции вычитания знак результата менялся
на противоположный всегда. Это казалось правильным, поскольку вычитаемое находится
в аккумуляторе, а уменьшаемое в памяти и производится вычитание уменьшаемого
из вычитаемого. Все хорошо пока операнды не равны, но при их равенстве получается
ноль и смена его знака дает минус ноль, который считается не равным обычному нулю.
В компиляторе есть одно место, в котором такое сравнение приводит к повреждению
содержимого памяти. Это функция вывода числа, которая нужна только в кросс-компиляторе:
word putn(word N, word B, word W) is
pStk:=0;
while W >0 do
Push (N%B);
N :=N/B;
W :=W-1;
if W=0 then
if N!=0 then
W=1;
end
end
end
nBuff:=0;
//Ошибка - условие всегда истинно
while pStk!=0 do
Buff[nBuff]:=char(Pop()+48);
nBuff :=nBuff+1;
end
Buff[nBuff] :=char(char(0x0A));
nBuff :=nBuff+1;
puts();
end
В функции Push() значение переменной pStk увеличивается на единицу, в функции Pop()
уменьшается. Последнее уменьшение должно дать ноль и цикл должен завешиться.
Вместо этого получается минус ноль, перед следующей итерацией условие цикла оценивается
как истинное (-0 != 0) и цикл продолжается. При дальнейшем уменьшении условие остается
истинным. Машина тем не менее останавливается и в памяти даже есть созданный код,
но перфокарты не пробиваются. Почему происходит именно так я пока вполне не понимаю,
но видно, что значение счетчика инструкций (IC) равно 03140, а по адресу 01002 записан код
000000003140 (HTR 03140)
А должен там быть код
200002101003 (TIX *+1,1,2)
и это первая команда блока вызова функции, который формируется функцией mkEnter().
По-видимому, остановка происходит при очередном вызове Pop(). Происхождение кода 3140
неясно, значения индексов pStk и nBuff находятся вне допустимых пределов, но в ячейке
памяти Stk[pStk] и в находящихся рядом с ней ячейках ничего похожего нет.
Если бы вызов функции putn() был закомментирован или если бы условие было написано так
//while pStk!=0 do
while pStk> 0 do
то условно работающий код был бы получен раньше, но ошибка была бы пропущена.
Кросс-компилятор получается заменой функций ввода-вывода от open() до halt() и
функции чтения перфокарты ReadCard() аналогами.
Также необходимо заменить
Объявление массива Text
Реализацию функции EmiM()
В тексте различия отмечены комментариями
//INFO For AMD64
и
//INFO For IBM704/7090
Функция EmiM() предназначена для выдачи отрицательных кодов операций.
Реализация не совсем честная, но работает.
Кросс-компилятор выводит в cтандартный поток вывода восьмеричные коды команд,
он доджен быть перенаправлен в файл и преобразован в формат cbn (column binary)
эмулятора simh. Исходный текст также должен быть преобразован в формат cbn.
Используется эмулятор simh.
Написать работающие функции ввода-вывода для эмулятора i704 пока не получилось,
причина пока не выяснена, сделать тоже самое для эмулятора i7090 удалось,
он и был использован для всего дальнейшего.
Также пока не получилось сделать перфокатру с работающим загрузчиком, поэтому
используетя файл инициализации i7090.ini. На реальной машине это эквивалентно
набору кода загрузчика на панели управления:
#RDS CDR0
dep 400 076200001321
#RCHA 405
dep 401 054000000405
#TCNA 404
dep 402 406000000404
#TRA 402
dep 403 002000000402
#HTR 0
dep 404 000000000000
#IOCD
dep 405 034100001000
set cdr0 format=cbn
set cdp0 format=cbn
att cdr0 c7090ibm.cbn
g 400
det cdr0
att cdr0 c7090ibm.prg.cbn
att cdp0 c7090ibm.cmp.cbn
Помимо кода загрузчика файл содержит команды подключения считывателя перфокарт
и перфоратора, а также команду загрузки кода компилятора в память (g 400).
Запуск компилятора выполняется командой g 1000.
Важно! Перед запуском эмулятора файл c7090ibm.cmp.cbn должен отсутствовать или быть пустым.
Исходный текст компилятора, первый работающий вариант. Не все сделано хорошо, поблемные места
и допущенные ошибки отмечены комментариями //TEST NNNN (NNNN - порядковый номер):
//INFO For AMD64
//char Text [16384]; // 0804C000
//INFO For IBM704/7090
word Text [ 1536];
word pText;
word nText;
word nLine;
//byte Code [16384];
word Code [12288];
word nCode;
word hFile; // 08068020
char Heap [ 2048]; // 08068028
word nHeap;
word Name [ 256];
word Cls [ 256];
word Sub [ 256];
word Type [ 256];
word Size [ 256];
word Ofs [ 256];
word nName;
word pData;
word nData;
word Stk [ 128];
word pStk;
char Buff [ 128]; // 0806BC50
word nBuff; // 0806BCD0
word open() is
return 0;
end
word read() is
inline 0c076200001321; // RDS CDR0
inline 0c054000000000*+11;// RCHA IOCD
//TEST 0019
//inline 0c406000000000*+2;// TCNA
inline-0c006000000000*+2;// TCNA
inline 0c002000000000*-1;// TRA
inline 0c064000000000*+9;// SCHA STAT
inline 0c050000000000*+9;// CLA MASK
inline 0c032000000000*+7;// ANS STAT
//TEST 0019
//inline 0c432000000000*+5;// ANA IOCD
inline-0c032000000000*+5;// ANA IOCD
inline 0c040200000000*+5;// SUB STAT
inline 0c010000000000*+2;// TZE
inline 0c076000000002; // CHS
inline 0c002000000000*+4;// TRA
inline 0c003000031000; // IOCD COUNT=0c3000, ADDR=0c31000
inline 0c000000000000; // STAT
inline 0c000000077777; // MASK
end
word write() is
inline 0c076600001341; // WRS CDP0
//inline 0c050000054003; // CLA nCode
inline 0c050000064003; // CLA nCode
inline 0c076700000022; // ALS 22
inline 0c062200000000*+4;// STD IOCD
inline 0c054000000000*+3;// RCHA *+3
inline-0c006000000000*+3;// TCNA
inline 0c002000000000*-1;// TRA
inline 0c000000034003; // IOCD
end
word close() is
return 0;
end
word puts() is
return 0;
end
word halt() is
inline 0c000000000000; // HTR
end
word pCode;
word Init() is
Heap[ 0]:='0';
Heap[ 1]:='1';
Heap[ 2]:='2';
Heap[ 3]:='3';
Heap[ 4]:='4';
Heap[ 5]:='5';
Heap[ 6]:='6';
Heap[ 7]:='7';
Heap[ 8]:='8';
Heap[ 9]:='9';
Heap[10]:='A';
Heap[11]:='B';
Heap[12]:='C';
Heap[13]:='D';
Heap[14]:='E';
Heap[15]:='F';
Heap[16]:='c';
Heap[17]:='h';
Heap[18]:='a';
Heap[19]:='r';
Heap[20]:= char(0);
Heap[21]:='b';
Heap[22]:='y';
Heap[23]:='t';
Heap[24]:='e';
Heap[25]:= char(0);
Heap[26]:='w';
Heap[27]:='o';
Heap[28]:='r';
Heap[29]:='d';
Heap[30]:= char(0);
Heap[31]:='b';
Heap[32]:='e';
Heap[33]:='g';
Heap[34]:='i';
Heap[35]:='n';
Heap[36]:= char(0);
Heap[37]:='i';
Heap[38]:='f';
Heap[39]:= char(0);
Heap[40]:='w';
Heap[41]:='h';
Heap[42]:='i';
Heap[43]:='l';
Heap[44]:='e';
Heap[45]:= char(0);
Heap[46]:='i';
Heap[47]:='n';
Heap[48]:='l';
Heap[49]:='i';
Heap[50]:='n';
Heap[51]:='e';
Heap[52]:= char(0);
Heap[53]:='r';
Heap[54]:='e';
Heap[55]:='t';
Heap[56]:='u';
Heap[57]:='r';
Heap[58]:='n';
Heap[59]:= char(0);
Heap[60]:='e';
Heap[61]:='n';
Heap[62]:='d';
Heap[63]:= char(0);
Heap[64]:='c';
Heap[65]:='.';
Heap[66]:='p';
Heap[67]:='r';
Heap[68]:='g';
Heap[69]:= char(0);
Heap[70]:='c';
Heap[71]:= char(0);
nHeap :=72;
Name[ 0]:=16;
Cls [ 0]:= 1;
Size[ 0]:= 1;
Name[ 1]:=21;
Cls [ 1]:= 1;
Size[ 1]:= 1;
Name[ 2]:=26;
Cls [ 2]:= 1;
//Size[ 2]:= 8;
Size[ 2]:= 1;
nName := 3;
pStk := 0;
nCode := 0;
pCode := 0c01000;
//pData := 0x0804C000;
pData := pCode+0c30000;
nData := pData;
end
word OpenSrc() is
hFile:=open();
end
word CloseSrc() is
close();
end
word Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
word putn(word N, word B, word W) is
pStk:=0;
//word I:=1;
//while I!=0 do
while W >0 do
Push (N%B);
N :=N/B;
//I :=N;
W :=W-1;
//TEST 0007
if W=0 then
if N!=0 then
W=1;
end
end
end
nBuff:=0;
while pStk!=0 do
Buff[nBuff]:=char(Pop()+48);
nBuff :=nBuff+1;
end
Buff[nBuff] :=char(char(0x0A));
nBuff :=nBuff+1;
puts();
end
word Stop() is
CloseSrc();
putn(nLine,10,1);
Buff[0] :=char(char(0xA));
nBuff :=1;
puts();
halt();
end
word val () is
word E:=10;
word I:= 0;
if Buff[0]='0' then
if Buff[1]='c' then
E:= 8;
I:= 2;
end
if Buff[1]='x' then
E:=16;
I:= 2;
end
end
word N:=0;
while Buff[I]!=char(0) do
word K:=0;
while Heap[K]!=Buff[I] do
if K=E then
Stop();
end
K:=K+1;
end
N:=E*N;
N:=N+K;
I:=I+1;
end
return N;
end
char Card [ 73];
word pChar;
word nChar;
//TEST 0014/Error in ReadCard()/i7090
word ReadCard() is
if pText>=nText then
pText:=0;
nText:=read();
end
if pText+24>nText then
Stop();
end
word Left0 :=0;
word Right0:=0;
word Left1 :=0;
word Right1:=0;
word rowMask0:=1;
word R0:=0;
while R0< 12 do
//TODO 2*R0 -> R0+R0/R0:=R0+2
word pT :=pText+(2*R0);
if Text[pT] < 0 then
Left0 :=Left0 +rowMask0;
Text [pT] :=0-Text[pT];
end
if Text[pT+1]< 0 then
Right0 :=Right0+rowMask0;
Text [pT+1]:=0-Text[pT+1];
end
if Text[pT] >=0c200000000000 then
Left1 :=Left1 +rowMask0;
end
if Text[pT+1]>=0c200000000000 then
Right1 :=Right1+rowMask0;
end
rowMask0:=rowMask0+rowMask0;
R0:=R0+1;
end
Card[ 0]:=char(Left0);
Card[ 1]:=char(Left1);
Card[36]:=char(Right0);
Card[37]:=char(Right1);
word colMask:=1;
//word C:=36;
//TEST 0015 Overflow, see code above
//while C> 0 do
//while C> 2 do
//while C>=3 do
word C:=3;
while C<=36 do
//C:=C-1;
word Left :=0;
word Right:=0;
word rowMask:=1;
word R:= 0;
while R< 12 do
word pT :=pText+(2*R);
//if Text[pText + 2*R] %(colMask+colMask)>=colMask then
//if Text[pText +(2*R)] %(colMask+colMask)>=colMask then
if Text[pT] %(colMask+colMask)>=colMask then
Left :=Left + rowMask;
end
//TEST 0014/No prty and right assoc!
//if Text[pText + 2*R +1]%(colMask+colMask)>=colMask then
//if Text[pText +(2*R)+1]%(colMask+colMask)>=colMask then
if Text[pT+1] %(colMask+colMask)>=colMask then
Right:=Right+ rowMask;
end
rowMask:=rowMask+rowMask;
R:=R+1;
end
//Card[C] :=char(Left);
//Card[C+36]:=char(Right);
Card[38-C]:=char(Left);
Card[74-C]:=char(Right);
colMask :=colMask+colMask;
C:=C+1;
end
Card[72]:=char(10);
pText:=pText+24;
pChar:=0;
nChar:=73;
end
char Look() is
if pChar>=nChar then
ReadCard();
end
//return Text[pText];
return Card[pChar];
end
char Read() is
char Ch:=Look();
if Ch =char(10) then
nLine :=nLine+1;
end
//pText :=pText+1;
pChar :=pChar+1;
return Ch;
end
word isalnum() is
if 'A'<=Look() then
if Look()<='Z' then
return 0;
end
end
if 'a'<=Look() then
if Look()<='z' then
return 0;
end
end
if '0'<=Look() then
if Look()<='9' then
return 0;
end
end
return 1;
end
word Digraph(char C1, char C2) is
if Buff[0]=C1 then
if Look()=C2 then
Buff[1]:=Read();
Buff[2]:=char(0);
end
end
end
char Scan() is
word pBuff:=0;
while pBuff =0 do
word sFlag:=0;
while sFlag =0 do
//TEST 0010
//if Look()!=char( 9) then
if Look()!=char( 0) then
if Look()!=char(10) then
if Look()!=char(13) then
if Look()!=char(32) then
sFlag:=1;
end
end
end
end
if sFlag=0 then
Read();
end
end
while isalnum()=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
Buff[pBuff] :=char(0);
Digraph('<', '=');
Digraph('!', '=');
Digraph('>', '=');
Digraph(':', '=');
if Buff[0]='/' then
if Look()='/' then
while Look()!=char(10) do
//TEST 0017
//if Read()=char(0) then
// Stop();
//end
Read();
end
pBuff:=0;
end
end
end
end
word Comp(word pHeap) is
word pBuff:=0;
while Buff[pBuff]=Heap[pHeap] do
if Buff[pBuff]=char(0) then
return 0;
end
pHeap:=pHeap+1;
pBuff:=pBuff+1;
end
return 1;
end
word Find(word fFlag) is
word pName:=0;
while pName< nName do
if Comp(Name[pName])=0 then
return pName;
end
pName:=pName+1;
end
if fFlag=0 then
Stop();
end
return pName;
end
word EmiW(word W) is
Code[nCode]:=W;
nCode:=nCode+1;
end
//TEST 0019
word EmiM(word W) is
//INFO For AMD64
//EmiW(0c400000000000+W);
//INFO For IBM704/7090
EmiW(0-W);
end
word EmiN(word W, word N) is
EmiW(W+pCode+nCode+N);
end
//TEST 0011
//word EmiA(word P, word A) is
word EmiT(word P, word A) is
//Code[P]:=Code[P]+pCode+A;
Code[P]:=0c002000000000+pCode+A;
end
word PushAC() is
EmiN(0c100001400000,1); // TXI *+1,4,1
EmiW(0c060100400001); // STO 1,4
end
word DecXR41() is
EmiN(0c200001400000,2); // TIX *+2,4,1
//EmiW(0c000000000100); // HTR
EmiW(0c042000000000); // HPR
//EmiW(0c076100000000); // NOP
end
word DecXR42() is
EmiN(0c200002400000,2); // TIX *+2,4,2
//EmiW(0c000000000200); // HTR
EmiW(0c042000000000); // HPR
//EmiW(0c076100000000); // NOP
end
word Assign(word I) is
if Size[I]>1 then
PushAC(); // push Value
EmiW(0c050000400002); // CLA 2,4 // Index
EmiW(0c076000000006); // COM
//TEST 0008
//EmiW(0c073400400000); // PAX 4
EmiW(0c073400100000); // PAX 1
EmiW(0c050000400001); // CLA 1,4 // Value
//TEST 0008
//EmiW(0c060100400000+Ofs[I]-1); // STO Ofs, 4
EmiW(0c060100100000+Ofs[I]-1); // STO Ofs, 4
//EmiN(0c200002400000,1);// TIX *+1,4,2
DecXR42();
end
if Size[I]=1 then
EmiW(0c060100000000+Ofs[I]); //STO
end
end
word pEnter;
word pLeave;
word Expr() is
word eFlag:=0;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
word W:=val();
EmiN(0c050000000000,2); // CLA *+2
EmiN(0c002000000000,2); // TRA *+2
EmiW(W);
eFlag:=1;
end
end
if Buff[0]=''' then
EmiN(0c050000000000,2); // CLA *+2
EmiN(0c002000000000,2); // TRA *+2
EmiW(word(Read()));
Read();
eFlag:=1;
end
if Buff[0]='(' then
Scan();
Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
Expr();
I:=Pop();
EmiW(0c076000000006); // COM
//TEST 0008
//EmiW(0c073400400000); // PAX 4
EmiW(0c073400100000); // PAX 1
//EmiW(0c050000400000+Ofs[I]-1); // CLA Ofs, 4
EmiW(0c050000100000+Ofs[I]-1); // CLA Ofs, 1
end
if Size[I]=1 then
EmiW(0c050000000000+Ofs[I]); // CLA
end
end
if Cls[I]=3 then
Scan(); // (
Push(I);
Sub[nName]:= 0;
word J:=I+1;
while Sub[J]=1 do
Push(J);
Scan();
Expr();
J:=Pop();
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
//TEST 0003/Error in val()
//EmiW(0xc007400100000+pEnter);// TSX
//EmiW(0xc002000000000+Ofs[I]);// TRA
EmiW(0c007400100000+pEnter); // TSX
EmiW(0c002000000000+Ofs[I]); // TRA
end
end
Scan();
word I:=0;
if Buff[0]='+' then
I:=1;
end
if Buff[0]='-' then
I:=2;
end
if Buff[0]='*' then
I:=3;
end
if Buff[0]='/' then
I:=4;
end
if Buff[0]='%' then
I:=5;
end
if I!=0 then
PushAC();
Push(I);
Scan();
Expr();
I:=Pop();
//TEST 0001/Remove
//EmiW(0c050000400001); // CLA 1,4 // Value
if I =1 then
EmiW(0c040000400001);// ADD 1,4
end
if I =2 then
EmiW(0c040200400001);// SUB 1,4
//TEST 0018
EmiN(0c010000000000,2);//TZE
EmiW(0c076000000002);// CHS
end
if I =3 then
EmiW(0c056000400001);// LDQ 1,4
EmiW(0c060100400001);// STO 1,4
EmiW(0c020000400001);// MPY 1,4
//TEST 0019
//EmiW(0c460000400001);// STQ 1,4
EmiM(0c060000400001);// STQ 1,4
EmiW(0c050000400001);// CLA 1,4
end
if I>=4 then
EmiW(0c056000400001);// LDQ 1,4
EmiW(0c060100400001);// STO 1,4
EmiW(0c040200400001);// SUB 1,4 //AC:=0
//TEST 0009
//EmiW(0c220000400001);// DVH 1,4
EmiW(0c022000400001);// DVH 1,4
end
if I=4 then
//TEST 0009
//EmiW(0c046000400001);// STQ 1,4
//TEST 0019
//EmiW(0c460000400001);// STQ 1,4
EmiM(0c060000400001);// STQ 1,4
EmiW(0c050000400001);// CLA 1,4
end
//EmiN(0c200001400000,1);// TIX *+1,4,1
DecXR41();
end
end
word Cond() is
Scan();
Expr();
word jCode:=0;
if Buff[0]='<' then
jCode:=0x83; // jae Ofs
if Buff[1]='=' then
jCode:=0x87; // ja Ofs
end
end
if Buff[0]='=' then
jCode:=0x85; // jne Ofs
end
if Buff[0]='!' then
jCode:=0x84; // je Ofs
end
if Buff[0]='>' then
jCode:=0x86; // jbe Ofs
if Buff[1]='=' then
jCode:=0x82; // jb Ofs
end
end
if jCode=0 then
Stop();
end
PushAC();
Scan();
Expr();
EmiW(0c034000400001); // CAS
if jCode=0x83 then // <
EmiN(0c002000000000,3);// TRA *+3
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
jCode:=0;
end
if jCode=0x87 then // <=
EmiN(0c002000000000,3);// TRA *+3
EmiN(0c002000000000,2);// TRA *+2
Push(nCode);
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
jCode:=0;
end
if jCode=0x85 then // =
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
EmiN(0c002000000000,2);// TRA *+2
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
jCode:=0;
end
if jCode=0x84 then // !=
EmiN(0c002000000000,2);// TRA *+2
Push(nCode);
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
jCode:=0;
end
if jCode=0x82 then // >=
Push(nCode);
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
EmiW(0c076100000000); // NOP
jCode:=0;
end
if jCode=0x86 then // >
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
Push(nCode);
EmiW(0c002000000000); // TRA NEXT
jCode:=0;
end
if jCode!=0 then
Stop();
end
//EmiN(0c200001400000,1); // TIX *+1,4,1
DecXR41();
end
word qFlag;
word Quit() is
if qFlag=1 then
EmiW(0c000000000000); // HTR 0
end
if qFlag=0 then
EmiW(0c002000000000+pLeave); // TRA
end
end
word Obj (word T) is
if Cls[T]!=1 then
Stop();
end
Name[nName]:=nHeap;
Type[nName]:= T;
Scan();
if Find(1)<nName then
Stop();
end
word pBuff:=0;
char Ch :=char(1);
while Ch !=char(0) do
Ch := Buff[pBuff];
Heap[nHeap]:= Ch;
nHeap :=nHeap+1;
pBuff :=pBuff+1;
end
Scan();
return nName;
end
char Var (word Subclass) is
Cls [nName]:= 2;
Sub [nName]:= Subclass;
Size[nName]:= 1;
Ofs [nName]:=nData;
if Buff[0]='[' then
if Subclass!=0 then
Stop();
end
Scan();
Size[nName]:=val();
Scan(); // ]
Scan(); // ;
end
nData :=nData+(Size[Type[nName]]*Size[nName]);
if nData>=0c74000 then
Stop();
end
nName :=nName+1;
return Buff[0];
end
word Hide() is
word I:=Pop();
while I< nName do
Heap[Name[I]]:=char(0);
I :=I+1;
end
end
//TEST 0005/Replace
//word Patch() is
word Patch(word pCode1, word pCode2) is
//TEST 0011
//EmiA(pCode1,nCode);
EmiT(pCode1,nCode);
//EmiA(pCode2,nCode);
EmiT(pCode2,nCode);
//EmiN(0c200001400000,1); // TIX *+1,4,1
DecXR41();
end
//word rFlag;
word Ctrl() is
word cFlag:=0;
//if cFlag =0 then
if Comp(37)=0 then // if
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
//TEST 0012/Stack correction bypass added
//TEST 0013/Wrong address
//EmiW(0c002000000002);// TRA
//TEST 0020/Wrong address when DecXR1()) used in Patch()
//EmiN(0c002000000000,2);// TRA
EmiN(0c002000000000,3);// TRA
word pSkip2:=Pop();
word pSkip1:=Pop();
Patch(pSkip1,pSkip2);
//rFlag:=1; // 14.05.2006
cFlag:=1;
end
//end
if cFlag =0 then
if Comp(40)=0 then // while
Push(nCode);
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
//TEST 0006/Wrong order
//Patch();
//EmiW(0c002000000000+pCode+Pop()); // TRA
word pExit2:=Pop();
word pExit1:=Pop();
word pLoop :=Pop();
EmiW(0c002000000000+pCode+pLoop); // TRA
Patch(pExit1,pExit2);
//rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(46)=0 then // inline
Buff[0]:=',';
while Buff[0]=',' do
Scan();
//TEST 0019
word Minus:=0;
if Buff[0]='-' then
Minus:=1;
Scan();
end
word C:=val();
Scan();
char Star:= Buff[0];
if Star ='*' then
Scan();
char PlusMn:= Buff[0];
Scan();
word N:=val();
if PlusMn ='+' then
//TODO Extract function
if Minus =0 then
EmiW(C+((pCode+nCode)+N));
end
if Minus!=0 then
EmiM(C+((pCode+nCode)+N));
end
end
//TODO Check for minus
if PlusMn!='+' then
if Minus =0 then
EmiW(C+((pCode+nCode)-N));
end
if Minus!=0 then
EmiM(C+((pCode+nCode)-N));
end
end
Scan();
end
if Star!='*' then
if Minus =0 then
EmiW(C);
end
if Minus!=0 then
EmiM(C);
end
end
end
//rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(53)=0 then // return
Scan();
Expr();
Quit();
//rFlag:=0;
cFlag:=1;
end
end
if cFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
word N:=Obj(I);
if Var(2)=':' then
Scan();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
PushAC();
end
Scan(); // :=
Scan();
Expr();
Assign(I);
end
if Cls[I]=3 then
Expr();
end
//rFlag:=1; // 14.05.2006
end
Scan();
end
word Func() is
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
//if rFlag!=0 then // 14.05.2006 // if rFlag=0 then
Quit();
//end
end
word dump() is
//INFO For AMD64
//word pC:=0;
//while pC< nCode do
// putn(Code[pC],8,12);
// pC:=pC+1;
//end
//INFO For IBM704/7090
write();
end
word MkEnter() is
pEnter:=pCode+nCode;
EmiN(0c200002100000,1); // TIX *+1,1,2
//TEST 0019
//EmiW(0c475400100000); // PXD
EmiM(0c075400100000); // PXD
EmiW(0c077100000022); // ASR 22
EmiN(0c040200000000,6); // SUB 77777
EmiN(0c062100000000,4); // STA TRA_CMD
//TEST 0004/ADM->SUB
//EmiN(0c040100000000,5); // ADM // ADM 1
EmiN(0c040200000000,5); // SUB // SUB 1
PushAC(); // Push ret addr
EmiW(0c002000000000); // TRA_CMD
EmiW(0c000000077777);
EmiW(0c000000000001);
end
word MkLeave() is
pLeave:=pCode+nCode;
//EmiW(0c050000400001); // CLA 1,4 // Ret addr
//EmiN(0c200002400000,1); // TIX *+1,4,1
//EmiN(0c062100000000,1); // STA TRA_CMD
//EmiW(0c002000000000); // TRA_CMD
//TEST 0002
PushAC(); // Result
EmiW(0c050000400002); // CLA 2,4 // Ret addr
//EmiN(0c062100000000,3); // STA TRA_CMD
EmiN(0c062100000000,4); // STA TRA_CMD
EmiW(0c050000400001); // CLA 1,4 // Result
//EmiN(0c200002400000,1); // TIX *+1,4,2
DecXR42();
EmiW(0c002000000000); // TRA_CMD
end
word ReserveInt() is
while nCode%8!=0 do
EmiW(0c000000000000); // HTR
end
end
word Reserve() is
ReserveInt();
EmiW(0c000000000000); // HTR
ReserveInt();
end
word Compile() is
OpenSrc();
pChar:=0;
nChar:=0;
pText:=0;
nText:=0;
nLine:=1;
qFlag:=0;
EmiW(0c002000000000); // TRA
EmiW(0c000000000001); // RX[4]/SP init value
MkEnter();
MkLeave();
Scan();
while Comp(31)!=0 do // !begin
Obj (Find(0));
char Ch:=Buff[0];
if Ch ='(' then
Cls [nName]:= 3;
Sub [nName]:= 0;
//Ofs [nName]:=nCode;
Ofs [nName]:=pCode+nCode;
nName :=nName+1;
Push(nName);
Scan(); // )
if Buff[0]!=')' then
Obj (Find(0));
while Var(1)=',' do
Scan();
Obj (Find(0));
end
end
Scan(); // is
Func();
Reserve();
Hide();
end
if Ch!='(' then
Var(0);
end
Scan();
end
EmiT(0,nCode);
//TEST 0016
//EmiW(0c073400400000+pCode+1); // LXA
EmiW(0c053400400000+pCode+1); // LXA
qFlag:=1;
Func ();
while nCode%24!=0 do
EmiW(0);
end
CloseSrc();
dump();
end
begin
Init();
Compile();
end
word ReadCard() is
pChar:=0;
nChar:=0;
if pText>=nText then
pText :=0;
nText :=read();
end
if pText>=nText then
Stop();
end
while Text[pText]!=char(10) do
if nChar<72 then
Card [nChar]:=Text[pText];
nChar:=nChar+1;
end
pText:=pText+1;
if pText>=nText then
pText :=0;
nText :=read();
end
if pText>=nText then
Stop();
end
end
while nChar<72 do
Card [nChar]:=' ';
nChar:=nChar+1;
end
Card[nChar]:=char(10);
nChar:=nChar+1;
pText:=pText+1;
end
Немного улучшенная функция чтения перфокарты (для IBM 704/7090):
word ReadCard() is
if pText>=nText then
pText:=0;
nText:=read();
end
if pText+24>nText then
Stop();
end
word Left0 :=0;
word Right0:=0;
word rowMask0:=1;
word R0:=0;
while R0< 12 do
//TODO 2*R0 -> R0+R0/R0:=R0+2
word pT :=pText+(2*R0);
if Text[pT] < 0 then
Left0 :=Left0 +rowMask0;
Text [pT] :=0-Text[pT];
end
if Text[pT+1]< 0 then
Right0 :=Right0+rowMask0;
Text [pT+1]:=0-Text[pT+1];
end
rowMask0:=rowMask0+rowMask0;
R0:=R0+1;
end
Card[ 0]:=char(Left0);
Card[36]:=char(Right0);
word colMask:=1;
word C:=35;
while C>= 1 do
word Left :=0;
word Right:=0;
word rowMask:=1;
word R:= 0;
while R< 12 do
word pT :=pText+(2*R);
if C>1 then
if Text[pT] %(colMask+colMask)>=colMask then
Left :=Left + rowMask;
end
if Text[pT+1] %(colMask+colMask)>=colMask then
Right:=Right+ rowMask;
end
end
if C=1 then
if Text[pT] >=colMask then
Left :=Left + rowMask;
end
if Text[pT+1]>=colMask then
Right:=Right+ rowMask;
end
end
rowMask:=rowMask+rowMask;
R:=R+1;
end
Card[C] :=char(Left);
Card[C+36]:=char(Right);
colMask :=colMask+colMask;
C:=C-1;
end
Card[72]:=char(10);
pText:=pText+24;
pChar:=0;
nChar:=73;
end