Re: Anyone here made their own programming language?
Posted: Mon Apr 10, 2023 11:46 am
Today, I have implemented the Routh-Hurwitz Stability Criterion in my programming language: https://flatassembler.github.io/hurwitz.html
Philosophical Vegan Forum
https://831048.arinterhk.tech/
Code: Select all
Function popuni_matricu() Which Returns Integer16 Does
Integer16 broj_stupaca :=
(stupanj_polinoma + 1) / 2 + mod(stupanj_polinoma + 1, 2),
broj_redaka := stupanj_polinoma + 1;
Integer16 i := 0;
//Popunimo matricu prvo not-a-numbersima...
While i < broj_redaka Loop
Integer16 j := 0;
While j < broj_stupaca Loop
matrica[f(i, j)] := 0. / 0.;
j += 1;
EndWhile
i += 1;
EndWhile
//Zatim idemo primjeniti Hurwitzov algoritam...
i := 0;
While i < broj_redaka Loop
Integer16 j := 0;
While j < broj_stupaca Loop
If i = 0 Then // Prvi redak
matrica[f(i, j)] := polinom[j * 2];
ElseIf i = 1 Then // Drugi redak
matrica[f(i, j)] := (j * 2 + 1 < stupanj_polinoma + 1) ?
polinom[j * 2 + 1] :
0;
Else // Ostali reci...
If matrica[f(i - 1, 0)] = 0 Then
//TODO: Implementirati što se radi u posebnim slučajevima...
Return 0;
EndIf
matrica[f(i, j)] := (matrica[f(i - 1, 0)] *
(j + 1 < broj_stupaca ?
matrica[f(i - 2, j + 1)] : 0) -
(matrica[f(i - 2, 0)] *
(j + 1 < broj_stupaca ?
matrica[f(i - 1, j + 1)] : 0))) /
matrica[f(i - 1 , 0)];
EndIf
j += 1;
EndWhile
i += 1;
EndWhile
If matrica[f(broj_redaka - 1, 0)] = polinom[stupanj_polinoma] Then
Return 1;
EndIf
Return 0;
EndFunction
Code: Select all
Function obrni_polinom() Which Returns Nothing Is Declared;
Function f(Integer16 i, Integer16 j) Which Returns Integer16 Does
// Za pretvaranje indeksa dvodimenzionalnog polja u indeks jednodimenzionalnog
// polja. Kada u svoj AEC compiler još nisam implementirao dvodimenzionalna
// polja...
Return 20 * i + j;
EndFunction
Function popuni_matricu() Which Returns Integer16 Does
Integer16 broj_stupaca :=
(stupanj_polinoma + 1) / 2 + mod(stupanj_polinoma + 1, 2),
broj_redaka := stupanj_polinoma + 1;
Integer16 i := 0;
//Popunimo matricu prvo not-a-numbersima...
While i < broj_redaka Loop
Integer16 j := 0;
While j < broj_stupaca Loop
matrica[f(i, j)] := 0. / 0.;
j += 1;
EndWhile
i += 1;
EndWhile
//Zatim idemo primjeniti Hurwitzov algoritam...
i := 0;
While i < broj_redaka Loop
Integer16 j := 0;
While j < broj_stupaca Loop
If i = 0 Then // Prvi redak
matrica[f(i, j)] := polinom[j * 2];
ElseIf i = 1 Then // Drugi redak
matrica[f(i, j)] := (j * 2 + 1 < stupanj_polinoma + 1) ?
polinom[j * 2 + 1] :
0;
Else // Ostali reci...
If matrica[f(i - 1, 0)] = 0 Then // Posebni slučajevi, kada se u prvom
// stupcu matrice pojavi nula.
If jesmo_li_obrnuli_polinom Then // Obrtanje polinoma nije "upalilo".
Return 0;
Else // Možda obrtanje polinoma "upali"...
obrni_polinom(); // https://www.forum.hr/showpost.php?p=97955497&postcount=16
jesmo_li_obrnuli_polinom := 1;
Return popuni_matricu();
EndIf
EndIf
matrica[f(i, j)] := (matrica[f(i - 1, 0)] *
(j + 1 < broj_stupaca ?
matrica[f(i - 2, j + 1)] : 0) -
(matrica[f(i - 2, 0)] *
(j + 1 < broj_stupaca ?
matrica[f(i - 1, j + 1)] : 0))) /
matrica[f(i - 1 , 0)];
EndIf
j += 1;
EndWhile
i += 1;
EndWhile
If matrica[f(broj_redaka - 1, 0)] = polinom[stupanj_polinoma] Then
Return 1;
EndIf
Return 0;
EndFunction
Function broj_korijena_u_desnoj_poluravnini() Which Returns Integer16 Does
Integer16 i := 1, brojac := 0;
While i < stupanj_polinoma + 1 Loop
brojac += not(signum(matrica[f(i, 0)]) = signum(matrica[f(i - 1, 0)]));
i += 1;
EndWhile
Return brojac;
EndFunction
Function obrni_polinom() Which Returns Nothing Does
Decimal64 pomocni_polinom[20];
Integer16 i := 0, j := stupanj_polinoma;
While i < stupanj_polinoma + 1 Loop
pomocni_polinom[i] := polinom[j];
i += 1;
j -= 1;
EndWhile
i := 0;
While i < stupanj_polinoma + 1 Loop
polinom[i] := pomocni_polinom[i];
i += 1;
EndWhile
EndFunction
Code: Select all
Structure First Consists Of
Nothing;
EndStructure
Structure Second Consists Of
Nothing;
EndStructure
Function main(Integer32 a, Integer32 b) Which Returns Nothing Does
InstantiateStructure First firstStructure;
InstantiateStructure Second secondStructure;
InstantiateStructure Second thirdStructure := (a > b) ? firstStructure : secondStructure;
EndFunction
Code: Select all
Running the tests...
All the tests passed in 4 milliseconds.
Reading the file "debug.aec"...
All characters read in 0 milliseconds.
Tokenizing the program...
Finished tokenizing the program in 0 milliseconds.
I have made a forum thread about how to speed up the tokenizer,
in case you are interested:
https://www.forum.hr/showthread.php?t=1243509
Parsing the program...
Finished parsing the program in 0 milliseconds.
Compiling the program...
Line 10, Column 29, Internal compiler error: Some part of the compiler attempted to compile an array with size less than 1, which doesn't make sense. Throwing an exception!
Internal compiler error: Uncaught exception in the compiler: St13runtime_error: Compiling an array of negative size!
If you have time, please report this to me on GitHub as an issue:
https://github.com/FlatAssembler/AECforWebAssembly/issues
Code: Select all
/*
* My solution to the n-queens puzzle, one of the classical problems of the
* structural programming. It asks in how many ways you can arrange n chess
* queens on an n-times-n chessboard without breaking the rules that no two
* chess queens can be in the same row, column or diagonal.
*/
// Import some functions we need to communicate with the outside world from
// JavaScript...
Function printString(PointerToCharacter str)
Which Returns Nothing Is External;
Function clearScreen() Which Returns Nothing Is External;
Function shouldWePrintChessBoards() Which Returns Integer32 Is External;
// Declare the "Queen" structure and write relevant functions.
Structure Queen Consists Of
Integer32 row, column;
EndStructure
Function areQueensInTheSameColumn(PointerToQueen first, PointerToQueen second)
Which Returns Integer32 Does
Return first->column = second->column;
EndFunction
Function areQueensInTheSameRow(PointerToQueen first, PointerToQueen second)
Which Returns Integer32 Does
Return first->row = second->row;
EndFunction
Function areQueensOnTheSameDiagonal(PointerToQueen first,
PointerToQueen second)
Which Returns Integer32 Does
Return first->row + first->column = second->row + second->column or
first->row - first->column = second->row - second->column;
EndFunction
Function areQueensAttackingEachOther(PointerToQueen first,
PointerToQueen second)
Which Returns Integer32 Does
Return areQueensInTheSameRow(first, second) or
areQueensInTheSameColumn(first, second) or
areQueensOnTheSameDiagonal(first, second);
EndFunction
// Let's write a structure representing an array of queens...
Structure ChessBoard Consists Of
Integer32 length;
Queen queens[12]; // There are too many solutions for over 12 queens.
EndStructure
Function chessBoardContainsThatQueen(PointerToChessBoard chessBoard,
PointerToQueen queen)
Which Returns Integer32 Does
Integer32 i := 0;
While i < chessBoard->length Loop
If chessBoard->queens[i].column = queen->column and
chessBoard->queens[i].row = queen->row Then
Return 1;
EndIf
i += 1;
EndWhile
Return 0;
EndFunction
// Now, let's forward-declare the functions we will write later.
// Putting them here would make the code less legible.
Function recursiveFunction(PointerToChessBoard chessBoard,
Integer32 n) Which Returns Integer32 Is Declared;
Function convertIntegerToString(PointerToCharacter str,
Integer32 n)
Which Returns Nothing Is Declared;
Function strcat(PointerToCharacter dest,
PointerToCharacter src) Which Returns Nothing Is Declared;
Function strlen(PointerToCharacter str) Which Returns Integer32 Is Declared;
// Let's write the function that JavaScript is supposed to call...
Function nQueensPuzzle(Integer32 n) Which Returns Integer32 Does
clearScreen();
If n < 1 or n > 12 Then
printString("Please enter a number between 1 and 12!");
Return -1;
EndIf
InstantiateStructure ChessBoard chessBoard;
Character stringToBePrinted[64] := {0};
PointerToCharacter stringToBePrinted := AddressOf(stringToBePrinted[0]);
strcat(stringToBePrinted, "Solving the n-queens puzzle for ");
convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted),
n);
strcat(stringToBePrinted,":\n");
printString(stringToBePrinted);
Integer32 result := recursiveFunction(AddressOf(chessBoard), n);
stringToBePrinted[0] := 0;
strcat(stringToBePrinted, "Found ");
convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted),
result);
strcat(stringToBePrinted, " solutions!");
printString(stringToBePrinted);
Return result;
EndFunction
// I guess moving this code out of "recursiveFunction" makes the
// code more legible.
Function printAsASolution(PointerToChessBoard chessBoard)
Which Returns Nothing Does
Character stringToBePrinted[64] := {0};
Character stringToBeAdded[8];
Integer32 i := 0;
While i < chessBoard->length Loop
stringToBeAdded[0] := 'A' + chessBoard->queens[i].column;
convertIntegerToString(AddressOf(stringToBeAdded[1]),
chessBoard->queens[i].row + 1);
strcat(AddressOf(stringToBeAdded[0]), " ");
strcat(AddressOf(stringToBePrinted[0]),
AddressOf(stringToBeAdded[0]));
i += 1;
EndWhile
strcat(AddressOf(stringToBePrinted[0]), "\n");
printString(AddressOf(stringToBePrinted[0]));
If shouldWePrintChessBoards() Then
stringToBePrinted[0] := 0;
PointerToCharacter stringToBePrinted := AddressOf(stringToBePrinted[0]);
strcat(stringToBePrinted, " +");
i := 0;
While i < chessBoard->length Loop
strcat(stringToBePrinted, "-+");
i += 1;
EndWhile
strcat(stringToBePrinted, "\n");
printString(stringToBePrinted);
i := chessBoard->length;
While i > 0 Loop
stringToBePrinted[0] := 0;
// Align the row numbers to the right.
If i < 10 Then
strcat(stringToBePrinted, " ");
EndIf
convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted), i);
strcat(stringToBePrinted, "|");
Integer32 j := 0;
While j < chessBoard->length Loop
InstantiateStructure Queen newQueen;
newQueen.column := j;
newQueen.row := i - 1;
strcat(stringToBePrinted,
chessBoardContainsThatQueen(chessBoard, AddressOf(newQueen))?
"Q|":
mod(i + j - 1, 2)?
" |": // White field.
"*|" // Black field.
);
j += 1;
EndWhile
strcat(stringToBePrinted, "\n");
printString(stringToBePrinted);
stringToBePrinted[0] := 0;
strcat(stringToBePrinted, " +");
j := 0;
While j < chessBoard->length Loop
strcat(stringToBePrinted, "-+");
j += 1;
EndWhile
strcat(stringToBePrinted, "\n");
printString(stringToBePrinted);
i -= 1;
EndWhile
stringToBePrinted[0] := 0;
PointerToCharacter stringToBeAdded := AddressOf(stringToBeAdded[0]);
stringToBeAdded[2] := 0;
stringToBeAdded[0] := ' ';
strcat(stringToBePrinted, " ");
i := 0;
While i < chessBoard->length Loop
stringToBeAdded[1] := 'A' + i;
strcat(stringToBePrinted, stringToBeAdded);
i += 1;
EndWhile
strcat(stringToBePrinted, "\n");
printString(stringToBePrinted);
EndIf
EndFunction
// Now, let's implement the brute-force algorithm.
Function recursiveFunction(PointerToChessBoard chessBoard,
Integer32 n) Which Returns Integer32 Does
// First, do some sanity checks useful for debugging...
If chessBoard->length > n Then
printString("Bug: Chessboard length too large!");
Return 0;
EndIf
Integer32 i := 0, j := 0;
While i < chessBoard->length Loop
If chessBoard->queens[i].column < 0 or
chessBoard->queens[i].row < 0 or
chessBoard->queens[i].column > n or
chessBoard->queens[i].row > n Then
printString("Bug: Corrupt chessboard!");
Return 0;
EndIf
i += 1;
EndWhile
// Check if there is a contradiction (queens attacking
// each other) in what we have thus far...
i := j := 0;
While i < chessBoard->length Loop
j := i + 1;
While j < chessBoard->length Loop
If not(i = j) and areQueensAttackingEachOther(
AddressOf(chessBoard->queens[i]),
AddressOf(chessBoard->queens[j])
) Then
Return 0;
EndIf
j += 1;
EndWhile
i += 1;
EndWhile
// Check if this is a solution...
If chessBoard->length = n Then
printAsASolution(chessBoard);
Return 1;
EndIf
// If this is not a complete solution, but there are no contradictions
// in it, branch the recursion into searching for complete solutions
// based on this one.
Integer32 result := 0;
i := 0;
While i<n Loop
InstantiateStructure ChessBoard newChessBoard := ValueAt(chessBoard);
newChessBoard.length += 1;
newChessBoard.queens[chessBoard->length].column := chessBoard->length;
newChessBoard.queens[chessBoard->length].row := i;
result += recursiveFunction(AddressOf(newChessBoard), n);
i += 1;
EndWhile
Return result;
EndFunction
// Now go the helper functions related to string manipulation,
// copied from the Dragon Curve program. They are named the same
// as the corresponding functions in the standard C library.
Function strlen(PointerToCharacter str) Which Returns Integer32 Does
Integer32 length := 0;
While ValueAt(str + length) Loop
length := length + 1;
EndWhile
Return length;
EndFunction
Function strcpy(PointerToCharacter dest,
PointerToCharacter src) Which Returns Nothing Does
While ValueAt(src) Loop
ValueAt(dest) := ValueAt(src);
dest := dest + 1;
src := src + 1;
EndWhile
ValueAt(dest) := 0;
EndFunction
Function strcat(PointerToCharacter dest,
PointerToCharacter src) Which Returns Nothing Does
strcpy(dest + strlen(dest), src);
EndFunction
Function reverseString(PointerToCharacter string) Which Returns Nothing Does
PointerToCharacter pointerToLastCharacter := string + strlen(string) - 1;
While pointerToLastCharacter - string > 0 Loop
Character tmp := ValueAt(string);
ValueAt(string) := ValueAt(pointerToLastCharacter);
ValueAt(pointerToLastCharacter) := tmp;
string := string + 1;
pointerToLastCharacter := pointerToLastCharacter - 1;
EndWhile
EndFunction
Function convertIntegerToString(PointerToCharacter string,
Integer32 number)
Which Returns Nothing Does
Integer32 isNumberNegative := 0;
If number < 0 Then
number := -number;
isNumberNegative := 1;
EndIf
Integer32 i := 0;
While number > 9 Loop
ValueAt(string + i) := '0' + mod(number, 10);
number := number / 10;
i := i + 1;
EndWhile
ValueAt(string + i) := '0' + number;
i := i + 1;
If isNumberNegative Then
ValueAt(string + i) := '-';
i := i + 1;
EndIf
ValueAt(string + i) := 0;
reverseString(string);
EndFunction
Code: Select all
;A very advanced example: Solving the n-Queens Puzzle.
; https://flatassembler.github.io/nQueensPuzzle.html
AsmStart
macro pushIntegerToTheSystemStack x
{
sub esp,4
fld dword [x]
fistp dword [esp]
}
macro pushPointerToTheSystemStack x
{
sub esp,4
lea ebx,[x]
mov [esp],ebx
}
macro pushStringToTheSystemStack x
{
sub esp,4
mov dword [esp],x
}
format PE console
entry start
include 'win32a.inc'
section '.text' code executable
start:
AsmEnd
enterTheNumberString <= "Enter the number of queens.", 10, 0
floatSign <= "%f", 0
AsmStart
pushPointerToTheSystemStack enterTheNumberString
call [printf]
add esp, 4 ;Cleaning up the system stack. When writing in assembly, there is no compiler to do that for you.
pushPointerToTheSystemStack n
pushPointerToTheSystemStack floatSign
call [scanf]
add esp, 8
AsmEnd
topOfMyStack := 1
numberOfSolutions := 0
myStack[topOfMyStack * (n + 1)] := 0
While topOfMyStack > 0
howManyQueensAreOnTheBoard := myStack[topOfMyStack * (n + 1)]
i := 0
While i < howManyQueensAreOnTheBoard
queens[i] := myStack[topOfMyStack * (n + 1) + i + 1]
i := i + 1
EndWhile
topOfMyStack := topOfMyStack - 1
If howManyQueensAreOnTheBoard = n
numberOfSolutions := numberOfSolutions + 1
i := 0
While i < n
integerSignFollowedBySpace <= "%d ", 0
'A' + i ;The compiler will store this into the variable "result"
AsmStart
pushIntegerToTheSystemStack result
call [putchar]
add esp, 4
AsmEnd
queens[i] + 1
AsmStart
pushIntegerToTheSystemStack result
pushPointerToTheSystemStack integerSignFollowedBySpace
call [printf]
add esp, 8
AsmEnd
i := i + 1
EndWhile
AsmStart
pushPointerToTheSystemStack newLineString
call [printf]
add esp, 4
AsmEnd
Else
rowOfTheQueenWeAreAboutToAdd := n - 1
columnOfTheQueenWeAreAboutToAdd := howManyQueensAreOnTheBoard
While rowOfTheQueenWeAreAboutToAdd > 0 | rowOfTheQueenWeAreAboutToAdd = 0
isThereAQueenInTheSameRow := 0
i := 0
While i < howManyQueensAreOnTheBoard
If queens[i] = rowOfTheQueenWeAreAboutToAdd
isThereAQueenInTheSameRow := 1
EndIf
i := i + 1
EndWhile
isThereAQueenOnTheSameGlavnaDijagonala := 0 ;Sorry, I don't know how to say "glavna dijagonala" and "sporedna dijagonala" in English, and I am not wasting my time looking that up.
i := 0
While i < howManyQueensAreOnTheBoard
If queens[i] + i = rowOfTheQueenWeAreAboutToAdd + columnOfTheQueenWeAreAboutToAdd
isThereAQueenOnTheSameGlavnaDijagonala := 1
EndIf
i := i + 1
EndWhile
isThereAQueenOnTheSameSporednaDijagonala := 0
i := 0
While i < howManyQueensAreOnTheBoard
If queens[i] - i = rowOfTheQueenWeAreAboutToAdd - columnOfTheQueenWeAreAboutToAdd
isThereAQueenOnTheSameSporednaDijagonala := 1
EndIf
i := i + 1
EndWhile
isThereAQueenOnTheSameDiagonal := isThereAQueenOnTheSameGlavnaDijagonala = 1 | isThereAQueenOnTheSameSporednaDijagonala = 1
If not(isThereAQueenInTheSameRow = 1) & not(isThereAQueenOnTheSameDiagonal = 1)
topOfMyStack := topOfMyStack + 1
myStack[topOfMyStack * (n + 1)] := howManyQueensAreOnTheBoard + 1
i := 0
While i < howManyQueensAreOnTheBoard
myStack[topOfMyStack * (n + 1) + i + 1] := queens[i]
i := i + 1
EndWhile
myStack[topOfMyStack * (n + 1) + howManyQueensAreOnTheBoard + 1] := rowOfTheQueenWeAreAboutToAdd
EndIf
rowOfTheQueenWeAreAboutToAdd := rowOfTheQueenWeAreAboutToAdd - 1
EndWhile
EndIf
EndWhile
foundSolutionsString <= "Found %d solutions!", 10, 0
AsmStart
pushIntegerToTheSystemStack numberOfSolutions
pushPointerToTheSystemStack foundSolutionsString
call [printf]
add esp, 8
invoke system, _pause
invoke exit, 0
_pause db "PAUSE",0
newLineString db 10,0
section '.rdata' readable writable
result dd ?
n dd ?
myStack dd 1024 dup(?)
queens dd 16 dup(?)
topOfMyStack dd ?
i dd ?
numberOfSolutions dd ?
howManyQueensAreOnTheBoard dd ?
rowOfTheQueenWeAreAboutToAdd dd ?
columnOfTheQueenWeAreAboutToAdd dd ?
isThereAQueenInTheSameRow dd ?
isThereAQueenOnTheSameGlavnaDijagonala dd ?
isThereAQueenOnTheSameSporednaDijagonala dd ?
isThereAQueenOnTheSameDiagonal dd ?
section '.idata' data readable import
library msvcrt,'msvcrt.dll'
import msvcrt,printf,'printf',system,'system',exit,'exit',scanf,'scanf',putchar,'putchar'
AsmEnd