with javascript_semantics
constant answers = {"As I see it, yes", "Ask again later", "You may rely on it",
                    "Without a doubt", "Don't bet on it", "Outlook not so good",
                    "Signs point to yes", "It is decidedly so", "It is certain",
                    "Better not tell you now", "My reply is no", "Outlook good",
                    "Concentrate and ask again", "Reply hazy, try again", "Yes",
                    "Most likely", "Cannot predict now", "My sources say maybe",
                    "My sources say no", "Yes, definitely", "Yes, probably not",
                    "Very doubtful", "Your question has already been answered"}

include pGUI.e
Ihandle dlg, vbox, question, answer

sequence answered = {}
bool clearkey = false

function key_cb(Ihandle /*dlg*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if -- (standard practice for me)
    if c=K_F5 then return IUP_DEFAULT end if -- (let browser reload work)
    if c=K_CR then
        string q = IupGetAttribute(question,"VALUE"), reply
        if length(q) then
            if find(q,answered) then
                reply = "Your question has already been answered"
            else
                answered = append(answered,q)
                reply = answers[rand(length(answers))]
            end if
            IupSetStrAttribute(answer,"TITLE",reply)
            clearkey = true
        end if
    elsif clearkey then
        IupSetAttribute(question,"VALUE","")
        clearkey = false
    end if
    return IUP_CONTINUE
end function

IupOpen()
question = IupText("EXPAND=HORIZONTAL")
answer = IupLabel("","EXPAND=HORIZONTAL")
vbox = IupVbox({question,answer},`MARGIN=40x40`)
dlg = IupDialog(vbox,`TITLE="Magic 8-ball",SIZE=250x100`)
IupSetCallback(dlg,"KEY_CB",Icallback("key_cb"))
IupShow(dlg)
if platform()!=JS then
    IupMainLoop()
    IupHide(dlg)
end if


<?php

$fortunes = array(
	"It is certain",
	"It is decidedly so",
	"Without a doubt",
	"Yes, definitely",
	"You may rely on it",
	"As I see it, yes",
	"Most likely",
	"Outlook good",
	"Signs point to yes",
	"Yes",
	"Reply hazy, try again",
	"Ask again later",
	"Better not tell you now",
	"Cannot predict now",
	"Concentrate and ask again",
	"Don't bet on it",
	"My reply is no",
	"My sources say no",
	"Outlook not so good",
	"Very doubtful"
);

/*
 * Prompt the user at the CLI for the command
 */
function cli_prompt( $prompt='> ', $default=false ) {

	// keep asking until a non-empty response is given
	do {
		// display the prompt
		echo $prompt;

		// read input and remove CRLF
		$cmd = chop( fgets( STDIN ) );

	} while ( empty( $default ) and empty( $cmd ) );

	return $cmd ?: $default;

}

$question = cli_prompt( 'What is your question? ' );

echo 'Q: ', $question, PHP_EOL;

echo 'A: ', $fortunes[ array_rand( $fortunes ) ], PHP_EOL;


Define.s Magic8="● It is certain."+#LF$+
                "● It is decidedly so."+#LF$+
                "● Without a doubt."+#LF$+
                "● Yes – definitely."+#LF$+
                "● You may rely on it."+#LF$+
                "● As I see it, yes."+#LF$+
                "● Most likely."+#LF$+
                "● Outlook good."+#LF$+
                "● Yes."+#LF$+
                "● Signs point To yes."+#LF$+
                "● Reply hazy, try again."+#LF$+
                "● Ask again later."+#LF$+
                "● Better Not tell you now."+#LF$+
                "● Cannot predict now."+#LF$+
                "● Concentrate And ask again."+#LF$+
                "● Don't count on it."+#LF$+
                "● My reply is no."+#LF$+
                "● My sources say no."+#LF$+
                "● Outlook Not so good."+#LF$+
                "● Very doubtful."+#LF$

                OpenConsole()

                Repeat
                  Print("MAGIC8: What would you like To know? "): q$=Input()
                  If Len(q$)=0 : End : EndIf
                  PrintN(StringField(Magic8,Random(CountString(Magic8,#LF$),1),#LF$))
                ForEver


import random

s = ('It is certain', 'It is decidedly so', 'Without a doubt', 'Yes, definitely',
 'You may rely on it', 'As I see it, yes', 'Most likely', 'Outlook good',
 'Signs point to yes', 'Yes', 'Reply hazy, try again', 'Ask again later',
 'Better not tell you now', 'Cannot predict now', 'Concentrate and ask again',
 "Don't bet on it", 'My reply is no', 'My sources say no', 'Outlook not so good',
 'Very doubtful')

q_and_a = {}

while True:
    question = input('Ask your question:')
    if len(question) == 0: break

    if question in q_and_a:
        print('Your question has already been answered')
    else:
        answer = random.choice(s)
        q_and_a[question] = answer
        print(answer)


[ 20 random
  [ table
    $ "Concentrate and ask again."       $ "Yes."
    $ "Better not tell you now." $ "Most likely."
    $ "Reply hazy, try again."  $ "Outlook good."
    $ "Outlook not so good."   $ "It is certain."
    $ "Cannot predict now."    $ "Very doubtful."
    $ "Signs point to yes."   $ "My reply is no."
    $ "It is decidedly so."  $ "Ask again later."
    $ "You may rely on it."  $ "Without a doubt."
    $ "Don't count on it."  $ "Yes - definitely."
    $ "My sources say no."  $ "As I see it, yes." ]
    do echo$ cr ]                                   is 8-ball ( --> )


eight_ball <- function()
{
    responses <- c("It is certain", "It is decidedly so", "Without a doubt",
                   "Yes, definitely", "You may rely on it", "As I see it, yes",
                   "Most likely", "Outlook good", "Signs point to yes", "Yes",
                   "Reply hazy, try again", "Ask again later",
                   "Better not tell you now", "Cannot predict now",
                   "Concentrate and ask again", "Don't bet on it",
                   "My reply is no", "My sources say no", "Outlook not so good",
                   "Very doubtful")

    question <- ""

    cat("Welcome to 8 ball!\n\n", "Please ask yes/no questions to get answers.",
        " Type 'quit' to exit the program\n\n")

    while(TRUE)
    {
        question <- readline(prompt="Enter Question: ")
        if(question == 'quit')
        {
            break
        }
        randint <- runif(1, 1, 20)
        cat("Response: ", responses[randint], "\n")
    }
}

if(!interactive())
{
    eight_ball()
}


(define eight-ball-responses
    (list "It is certain" "It is decidedly so" "Without a doubt" "Yes definitely" "You may rely on it"
          "As I see it, yes" "Most likely" "Outlook good" "Yes" "Signs point to yes"
          "Reply hazy try again" "Ask again later" "Better not tell you now" "Cannot predict now"
          "Concentrate and ask again"
          "Don't count on it" "My reply is no" "My sources say no" "Outlook not so good"
          "Very doubtful"))

(define ((answer-picker answers)) (sequence-ref answers (random (sequence-length answers))))

(define magic-eightball (answer-picker eight-ball-responses))

(module+ main
 (let loop ()
   (display "What do you want to know\n?")
   (read-line)
   (displayln (magic-eightball))
   (loop)))


put 'Please enter your question or a blank line to quit.';

["It is certain", "It is decidedly so", "Without a doubt", "Yes, definitely",
 "You may rely on it", "As I see it, yes", "Most likely", "Outlook good",
 "Signs point to yes", "Yes", "Reply hazy, try again", "Ask again later",
 "Better not tell you now", "Cannot predict now", "Concentrate and ask again",
 "Don't bet on it", "My reply is no", "My sources say no", "Outlook not so good",
 "Very doubtful"].roll.put while prompt('? : ').chars;


/* REXX */
Call mk_a "It is certain", "It is decidedly so", "Without a doubt",,
          "Yes, definitely", "You may rely on it", "As I see it, yes",,
          "Most likely", "Outlook good", "Signs point to yes", "Yes",,
          "Reply hazy, try again", "Ask again later",,
          "Better not tell you now", "Cannot predict now",,
          "Concentrate and ask again", "Don't bet on it",,
          "My reply is no", "My sources say no", "Outlook not so good",,
          "Very doubtful"
Do Forever
  Say 'your question:'
  Parse Pull q
  If q='' Then Leave
  z=random(1,a.0)
  Say a.z
  Say ''
  End
Exit
mk_a:
a.0=arg()
Do i=1 To a.0
  a.i=arg(i)
  End
Return


# Project : Magic 8-Ball

answers = ["It is certain", "It is decidedly so", "Without a doubt",
                 "Yes, definitely", "You may rely on it", "As I see it, yes",
                 "Most likely", "Outlook good", "Signs point to yes", "Yes",
                 "Reply hazy, try again", "Ask again later",
                 "Better not tell you now", "Cannot predict now",
                 "Concentrate and ask again", "Don't bet on it",
                 "My reply is no", "My sources say no", "Outlook not so good",
                 "Very doubtful"]
index = random(len(answers)-1)+1
see answers[index] + nl


#!/usr/bin/ruby

class EightBall
  def initialize
    print "Welcome to 8 ball! Ask your question below. "
    puts "Type 'quit' to exit the program.\n\n"
    @responses = ["It is certain", "It is decidedly so",
                          "Without a doubt", "Yes, definitely",
                          "You may rely on it", "As I see it, yes",
                          "Most likely", "Outlook good",
                          "Signs point to yes", "Yes",
                          "Reply hazy, try again", "Ask again later",
                          "Better not tell you now",
                          "Cannot predict now",
                          "Concentrate and ask again", "Don't bet on it",
                          "My reply is no", "My sources say no",
                          "Outlook not so good", "Very doubtful"]
  end

  def ask_question
    print "Question: "
    question = gets

    if question.chomp.eql? "quit"
      exit(0)
    end

    puts "Response: #{@responses.sample} \n\n"
  end

  def run
    loop do
      ask_question
    end
  end
end

eight_ball = EightBall.new
eight_ball.run


extern crate rand;

use rand::prelude::*;
use std::io;

fn main() {
    let answers = [
        "It is certain",
        "It is decidedly so",
        "Without a doubt",
        "Yes, definitely",
        "You may rely on it",
        "As I see it, yes",
        "Most likely",
        "Outlook good",
        "Signs point to yes",
        "Yes",
        "Reply hazy, try again",
        "Ask again later",
        "Better not tell you now",
        "Cannot predict now",
        "Concentrate and ask again",
        "Don't bet on it",
        "My reply is no",
        "My sources say no",
        "Outlook not so good",
        "Very doubtful",
    ];
    let mut rng = rand::thread_rng();
    let mut input_line = String::new();

    println!("Please enter your question or a blank line to quit.\n");
    loop {
        io::stdin()
            .read_line(&mut input_line)
            .expect("The read line failed.");
        if input_line.trim() == "" {
            break;
        }
        println!("{}\n", answers.choose(&mut rng).unwrap());
        input_line.clear();
    }
}


class MAIN is
   const answers: ARRAY{STR} :=
               |
               "It is certain.", "It is decidedly so.",
               "Without a doubt.", "Yes - definitely.", "You may rely on it.",
               "As I see it, yes.", "Most likely.", "Outlook good.",
               "Yes.", "Signs point to yes.", "Reply hazy, try again.",
               "Ask again later.", "Better not tell you now.", "Cannot predict now.",
               "Concentrate and ask again.", "Don't count on it.", "My reply is no.",
               "My sources say no.", "Outlook not so good.", "Very doubtful."
               |;
   main is
      RND::seed := #TIMES.wall_time;
      loop
         #OUT+"Your question: "; #OUT.flush;
         question ::= #IN.get_str;
         #OUT+answers[RND::int(0, answers.size-1)] + "\n";
      end;
   end;
end;


import scala.util.Random

object Magic8Ball extends App {
  val shake: () => String = {
    val answers = List(
      "It is certain.", "It is decidedly so.", "Without a doubt.",
      "Yes – definitely.", "You may rely on it.", "As I see it, yes.",
      "Most likely.", "Outlook good.", "Yes.", "Signs point to yes.",
      "Reply hazy, try again.", "Ask again later", "Better not tell you now.",
      "Cannot predict now.", "Concentrate and ask again.", "Don't count on it.",
      "My reply is no.", "My sources say no.", "Outlook not so good.",
      "Very doubtful."
    )
    val r = new Random
    () => answers(r.nextInt(answers.length))
  }

  println("Ask the Magic 8-Ball your questions. ('q' or 'quit' to quit)\n")

  while (true) {
    io.StdIn.readLine("Question: ").toLowerCase match {
      case "q" | "quit" =>
        println("Goodbye.")
        sys.exit()
      case _ =>
        println(s"Response: ${shake()}\n")
    }
  }
}


namespace path {::tcl::mathop ::tcl::mathfunc}

set answers {
	"As I see it, yes"
	"Ask again later"
	"Better not tell you now"
	"Cannot predict now"
	"Concentrate and ask again"
	"Don't bet on it"
	"It is certain"
	"It is decidedly so"
	"Most likely"
	"My reply is no"
	"My sources say maybe"
	"My sources say no"
	"Outlook good"
	"Outlook not so good"
	"Reply hazy, try again"
	"Signs point to yes"
	"Very doubtful"
	"Without a doubt"
	"Yes"
	"Yes, definitely"
	"Yes, probably not"
	"You may rely on it"
	"Your question has already been answered"
}

puts -nonewline "Question: "; flush stdout
while {[gets stdin line] > 0} {
	set answer [lindex $answers [int [* [rand] [llength $answers]]]]
	puts "⑧ says “$answer”"
	puts -nonewline "Question: "; flush stdout
}


10 PRINT "Concentrate hard on your question, then tell me your favorite number."
20 INPUT N
30 REM in lieu of a random number generator
40 IF N<0 THEN LET N=-N
50 IF N<20 THEN GOTO 1000+N*10
60 LET N=N-20
70 GOTO 50
1000 PRINT "It is certain."
1005 END
1010 PRINT "It is decidedly so."
1015 END
1020 PRINT "Without a doubt."
1025 END
1030 PRINT "Yes - definitely."
1035 END
1040 PRINT "You may rely on it."
1045 END
1050 PRINT "As I see it, yes."
1055 END
1060 PRINT "Most likely."
1065 END
1070 PRINT "Outlook good."
1075 END
1080 PRINT "Yes."
1085 END
1090 PRINT "Signs point to yes."
1095 END
1100 PRINT "Reply hazy, try again."
1105 END
1110 PRINT "Ask again later."
1115 END
1120 PRINT "Better not tell you now."
1125 END
1130 PRINT "Cannot predict now."
1135 END
1140 PRINT "Concentrate and ask again."
1145 END
1150 PRINT "Don't count on it."
1155 END
1160 PRINT "My reply is no."
1165 END
1170 PRINT "My sources say no."
1175 END
1180 PRINT "Outlook not so good."
1185 END
1190 PRINT "Very doubtful."


Push Dup("It is certain"), Dup("It is decidedly so"), Dup("Without a doubt")
Push Dup("Yes, definitely"), Dup("You may rely on it")
Push Dup("As I see it, yes"), Dup("Most likely"), Dup("Outlook good")
Push Dup("Signs point to yes"), Dup("Yes"), Dup("Reply hazy, try again")
Push Dup("Ask again later"), Dup("Better not tell you now")
Push Dup("Cannot predict now"), Dup("Concentrate and ask again")
Push Dup("Don't bet on it"), Dup("My reply is no"), Dup("My sources say no")
Push Dup("Outlook not so good"), Dup("Very doubtful")
                                       ' read the replies
For x = 0 to Used() - 1 : @(x) = Pop(): Next
Print "Please enter your question or a blank line to quit.\n"
                                       ' now show the prompt
Do
  r = Ask("? : ")                      ' ask a question
Until Len(r)=0                         ' check for empty line
  Print Show(@(Rnd(x))) : Print        ' show the reply
Loop


#!/bin/bash

RESPONSES=("It is certain" "It is decidedly so" "Without a doubt"
           "Yes definitely" "You may rely on it" "As I see it yes"
           "Most likely" "Outlook good" "Signs point to yes" "Yes"
           "Reply hazy try again" "Ask again later"
           "Better not tell you now" "Cannot predict now"
           "Concentrate and ask again" "Don't bet on it"
           "My reply is no" "My sources say no" "Outlook not so good"
           "Very doubtful")

printf "Welcome to 8 ball! Enter your questions using the prompt below to
find the answers you seek. Type 'quit' to exit.\n\n"

while true; do
    read -p 'Enter Question: ' question
    if [ "$question" == "quit" ]; then
        exit 0
    fi

    response_index=$(($RANDOM % 20))

    printf "Response: ${RESPONSES[response_index]}\n\n"
done


import "random" for Random
import "io" for Stdin, Stdout

var answers = [
    "It is certain", "It is decidedly so", "Without a doubt",
    "Yes, definitely", "You may rely on it", "As I see it, yes",
    "Most likely", "Outlook good", "Signs point to yes", "Yes",
    "Reply hazy, try again", "Ask again later",
    "Better not tell you now", "Cannot predict now",
    "Concentrate and ask again", "Don't bet on it",
    "My reply is no", "My sources say no", "Outlook not so good",
    "Very doubtful"
]
var rand = Random.new()
System.print("Please enter your question or a blank line to quit.")
while (true) {
    System.write("\n? : ")
    Stdout.flush()
    var question = Stdin.readLine()
    if (question.trim() == "") return
    var answer = answers[rand.int(20)]
    System.print("\n%(answer)")
}


set Responses = ["It is Certain.","It is decidedly so.","Without a doubt.","Yes definitely.","You may rely on it","As I see it, yes.","Most likely.","Outlook good.","Yes.","Sign points to yes.","Reply hazy, try again.","Ask again later.","Better not tell you now.","Cannot predict now.","Concentrate and ask again.","Don't count on it.","My reply is no.","My sources say no.","Outlook not so good.","Very doubtful."];

while(true){
	window->prompt("Ask 8-Ball a question");
	log(Responses[rnd(0,?Responses-1)]);
}


int     Answers, Answer, Question;
[Answers:= [
        "It is certain", "It is decidedly so", "Without a doubt",
        "Yes, definitely", "You may rely on it", "As I see it, yes",
        "Most likely", "Outlook good", "Signs point to yes", "Yes",
        "Reply hazy, try again", "Ask again later",
        "Better not tell you now", "Cannot predict now",
        "Concentrate and ask again", "Don't bet on it",
        "My reply is no", "My sources say no", "Outlook not so good",
        "Very doubtful"];
Text(0, "Please enter your question or a blank line to quit.
");
while true do
        [CrLf(0);  Text(0, "? : ");
        Question:= ChIn(0);
        if Question = \CR\$0D then return;
        OpenI(0);       \discard any remaining chars in keyboard buffer
        Answer:= Answers(Ran(20));
        Text(0, Answer);  CrLf(0);
        ]
]


answers:=T(
   "It is certain", "It is decidedly so", "Without a doubt",
   "Yes, definitely", "You may rely on it", "As I see it, yes",
   "Most likely", "Outlook good", "Signs point to yes", "Yes",
   "Reply hazy, try again", "Ask again later",
   "Better not tell you now", "Cannot predict now",
   "Concentrate and ask again", "Don't bet on it",
   "My reply is no", "My sources say no", "Outlook not so good",
   "Very doubtful"
);
println("Please enter your question or a blank line to quit.");
while(ask("? : ")){ println(answers[(0).random(answers.len())]) }


with Ada.Text_IO;

with AWS.Client;
with AWS.Response;
with AWS.Messages;

procedure MAC_Vendor is

   procedure Lookup (MAC : in String) is
      use AWS.Response;
      use AWS.Messages;
      URL     : constant String := "http://api.macvendors.com/" & MAC;
      Page    : constant Data   := AWS.Client.Get (URL);
      use Ada.Text_IO;
   begin
      Put (MAC);
      Set_Col (20);
      case AWS.Response.Status_Code (Page) is
         when S200   => Put_Line (Message_Body (Page));
         when S404   => Put_Line ("N/A");
         when others => Put_Line ("Error");
      end case;
   end Lookup;

begin
   --  Have to throttle traffic to site
   Lookup ("88:53:2E:67:07:BE");   delay 1.500;
   Lookup ("D4:F4:6F:C9:EF:8D");   delay 1.500;
   Lookup ("FC:FB:FB:01:FA:21");   delay 1.500;
   Lookup ("4c:72:b9:56:fe:bc");   delay 1.500;
   Lookup ("00-14-22-01-23-45");   delay 1.500;
   Lookup ("23-45-67");            delay 1.500;
   Lookup ("foobar");
end MAC_Vendor;


set {table, macList} to {{return}, {"88:53:2E:67:07:BE", "D4:F4:6F:C9:EF:8D", "FC:FB:FB:01:FA:21", "4c:72:b9:56:fe:bc", "00-14-22-01-23-45"}}

repeat with burger in macList
	set end of table to do shell script "curl http://api.macvendors.com/" & burger & " && sleep 5 && echo '\n'" & return
end repeat

return table as string


loop ["FC-A1-3E" "FC:FB:FB:01:FA:21" "BC:5F:F4"] 'mac [
    print [mac "=>" read ~"http://api.macvendors.com/|mac|"]
    pause 1500
]


macLookup(MAC){
	WebRequest := ComObjCreate("WinHttp.WinHttpRequest.5.1")
	WebRequest.Open("GET", "http://api.macvendors.com/" MAC)
	WebRequest.Send()
	return WebRequest.ResponseText
}


OPTION TLS TRUE

website$ = "api.macvendors.com"
mac$ = "b0:52:16:d0:3c:fb"

OPEN website$ & ":443" FOR NETWORK AS mynet
    SEND "GET /" & mac$ & " HTTP/1.1\r\nHost: " & website$ & "\r\n\r\n" TO mynet
    RECEIVE info$ FROM mynet
CLOSE NETWORK mynet

PRINT TOKEN$(info$, 2, "\r\n\r\n")


#include <curl/curl.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>

/* Length of http://api.macvendors.com/ */
#define FIXED_LENGTH 16

struct MemoryStruct {
  char *memory;
  size_t size;
};

static size_t WriteMemoryCallback(void *contents, size_t size, size_t nmemb, void *userp)
{
  size_t realsize = size * nmemb;
  struct MemoryStruct *mem = (struct MemoryStruct *)userp;

  mem->memory = realloc(mem->memory, mem->size + realsize + 1);

  memcpy(&(mem->memory[mem->size]), contents, realsize);
  mem->size += realsize;
  mem->memory[mem->size] = 0;

  return realsize;
}

void checkResponse(char* str){
	char ref[] = "Vendor not found";
	int len = strlen(str),flag = 1,i;

	if(len<16)
		fputs(str,stdout);
	else{
		for(i=0;i<len && i<16;i++)
			flag = flag && (ref[i]==str[i]);

		flag==1?fputs("N/A",stdout):fputs(str,stdout);
	}
}

int main(int argC,char* argV[])
{
		if(argC!=2)
			printf("Usage : %s <MAC address>",argV[0]);
		else{
			CURL *curl;
			int len = strlen(argV[1]);
			char* str = (char*)malloc((FIXED_LENGTH + len)*sizeof(char));
			struct MemoryStruct chunk;
			CURLcode res;

			chunk.memory = malloc(1);
			chunk.size = 0;

        if ((curl = curl_easy_init()) != NULL) {
				sprintf(str,"http://api.macvendors.com/%s",argV[1]);

                                curl_easy_setopt(curl, CURLOPT_URL, str);
				curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, WriteMemoryCallback);
				curl_easy_setopt(curl, CURLOPT_WRITEDATA, (void *)&chunk);

				free(str);

				res = curl_easy_perform(curl);

                if (res == CURLE_OK) {
				checkResponse(chunk.memory);
                                return EXIT_SUCCESS;
                }

                curl_easy_cleanup(curl);
			}
		}

        return EXIT_FAILURE;
}


using System;
using System.Net;
using System.Net.Http;
using System.Threading.Tasks;

class Program
{
    static async Task<string> LookupMac(string MacAddress)
    {
        var uri = new Uri("http://api.macvendors.com/" + WebUtility.UrlEncode(MacAddress));
        using (var wc = new HttpClient())
            return await wc.GetStringAsync(uri);
    }
    static void Main(string[] args)
    {
        foreach (var mac in new string[] { "88:53:2E:67:07:BE", "FC:FB:FB:01:FA:21", "D4:F4:6F:C9:EF:8D" })
            Console.WriteLine(mac + "\t" + LookupMac(mac).Result);
        Console.ReadLine();
    }
}


// This code is based on the example 'Simple HTTP Client' included with
// the Boost documentation.

#include <boost/beast/core.hpp>
#include <boost/beast/http.hpp>
#include <boost/beast/version.hpp>
#include <boost/asio/connect.hpp>
#include <boost/asio/ip/tcp.hpp>
#include <iostream>
#include <string>

bool get_mac_vendor(const std::string& mac, std::string& vendor) {
    namespace beast = boost::beast;
    namespace http = beast::http;
    namespace net = boost::asio;
    using tcp = net::ip::tcp;

    net::io_context ioc;
    tcp::resolver resolver(ioc);
    const char* host = "api.macvendors.com";

    beast::tcp_stream stream(ioc);
    stream.connect(resolver.resolve(host, "http"));

    http::request<http::string_body> req{http::verb::get, "/" + mac, 10};
    req.set(http::field::host, host);
    req.set(http::field::user_agent, BOOST_BEAST_VERSION_STRING);
    http::write(stream, req);

    beast::flat_buffer buffer;
    http::response<http::string_body> res;
    http::read(stream, buffer, res);

    bool success = res.result() == http::status::ok;
    if (success)
        vendor = res.body();

    beast::error_code ec;
    stream.socket().shutdown(tcp::socket::shutdown_both, ec);
    if (ec && ec != beast::errc::not_connected)
        throw beast::system_error{ec};

    return success;
}

int main(int argc, char** argv) {
    if (argc != 2 || strlen(argv[1]) == 0) {
        std::cerr << "usage: " << argv[0] << " MAC-address\n";
        return EXIT_FAILURE;
    }
    try {
        std::string vendor;
        if (get_mac_vendor(argv[1], vendor)) {
            std::cout << vendor << '\n';
            return EXIT_SUCCESS;
        } else {
            std::cout << "N/A\n";
        }
    } catch(std::exception const& e) {
        std::cerr << "Error: " << e.what() << std::endl;
    }
    return EXIT_FAILURE;
}


(quicklisp:quickload :Drakma)            ; or load it in another way

(defun mac-vendor (mac)
  (check-type mac string "A MAC address as a string")
  (multiple-value-bind (vendor status)
    (drakma:http-request (format nil "http://api.macvendors.com/~a" mac))
    (if (= 200 status)
      (format t "~%Vendor is ~a" vendor)
      (error "~%Not a MAC address: ~a" mac))))


program MAC_Vendor_Lookup;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  IdHttp;

function macLookUp(mac: string): string;
begin
  Result := '';
  with TIdHTTP.Create(nil) do
  begin
    try
      Result := Get('http://api.macvendors.com/' + mac);

    except
      on E: Exception do
        Writeln(e.Message);
    end;
    Free;
  end;
end;

begin
  Writeln(macLookUp('FC-A1-3E'));
  sleep(1000);
  Writeln(macLookUp('FC:FB:FB:01:FA:21'));
  sleep(1000);
  Writeln(macLookUp('BC:5F:F4'));
  readln;
end.


USING: accessors calendar continuations http.client io kernel
sequences threads ;

: mac-vendor ( str -- str )
    "http://api.macvendors.com/" prepend
    [ http-get nip ] [ nip response>> message>> ] recover ;

"FC-A1-3E"
"FC:FB:FB:01:FA:21"
"10-11-22-33-44-55-66"
[ mac-vendor print 1 seconds sleep ] [email protected]


Function pipeout(Byval s As String = "") Byref As String
    Var f = Freefile
    Dim As String tmp
    Open Pipe s For Input As #f
    s = ""
    Do Until Eof(f)
        Line Input #f, tmp
        s &= tmp
    Loop
    Close #f
    Return s
End Function

Function lookupvendor(webpage As String, mac As String) As String
    Return pipeout("powershell " + "(Invoke-WebRequest " + webpage + mac + ")")
End Function

Dim As String macs(1 To 4) = {"FC-A1-3E","FC:FB:FB:01:FA:21","88:53:2E:67:07:BE","D4:F4:6F:C9:EF:8D"}

For i As Integer = 1 To Ubound(macs)
    Var d = lookupvendor("api.macvendors.com/", macs(i))
    Var e = Instr(d, "RawContent")
    Print Mid(d, 66, e-66)
Next i
Sleep


program MACVendorLookup;

uses
  fphttpclient;

var
  res: String;
begin
  if paramCount > 0 then begin

    With TFPHttpClient.Create(Nil) do
    try
      allowRedirect := true;
      try
        res := Get('http://api.macvendors.com/' + ParamStr(1));
        writeLn(res);
      except
        writeLn('N/A');
      end;
    finally
      Free;
    end;
  end;
end.


package main

import (
	"net/http"
	"fmt"
	"io/ioutil"
)

func macLookUp(mac string) (res string){
	resp, _ := http.Get("http://api.macvendors.com/" + mac)
	body, _ := ioutil.ReadAll(resp.Body)
	res = string(body)
	return
}

func main()  {
	fmt.Println(macLookUp("FC-A1-3E"))
	fmt.Println(macLookUp("FC:FB:FB:01:FA:21"))
	fmt.Println(macLookUp("BC:5F:F4"))
}


#!/usr/bin/env stack
{- stack
  script
  --resolver lts-9.0
  --package bytestring
  --package http-client
  --package http-types
-}

{-# LANGUAGE MultiWayIf #-}

import Control.Exception (try)
import Control.Monad (forM_)
import qualified Data.ByteString.Lazy.Char8 as L8 (ByteString, unpack)
import Network.HTTP.Client
  (Manager, parseRequest, httpLbs, responseStatus, responseBody,
   newManager, defaultManagerSettings, Response, HttpException)
import Network.HTTP.Types.Status (statusIsSuccessful, notFound404)
import System.Environment (getArgs)
import Text.Printf (printf)

fetchURL :: Manager
         -> String
         -> IO (Either HttpException (Response L8.ByteString))
fetchURL mgr url = try $ do
  req <- parseRequest url
  httpLbs req mgr

lookupMac :: Manager -> String -> IO String
lookupMac mgr mac = do
  eth <- fetchURL mgr $ "http://api.macvendors.com/" ++ mac
  return $ case eth of
             Left _ -> "null"
             Right resp -> let body = responseBody resp
                               status = responseStatus resp
                           in if | status == notFound404 -> "N/A"
                                 | not (statusIsSuccessful status) -> "null"
                                 | otherwise -> L8.unpack body

main :: IO ()
main = do
  args <- getArgs
  mgr <- newManager defaultManagerSettings
  forM_ args $ \mac -> do
    putStr $ printf "%-17s" mac ++ " = "
    vendor <- lookupMac mgr mac
    putStrLn vendor


require 'web/gethttp'
lookupMACvendor=: [: gethttp 'http://api.macvendors.com/'&,


package com.jamesdonnell.MACVendor;

import java.io.BufferedReader;
import java.io.FileNotFoundException;
import java.io.IOException;
import java.io.InputStreamReader;
import java.net.HttpURLConnection;
import java.net.URL;

/** MAC Vendor Lookup class.
 * www.JamesDonnell.com
 * @author James A. Donnell Jr. */
public class Lookup {
	/** Base URL for API. The API from www.macvendors.com was chosen. */
	private static final String baseURL = "http://api.macvendors.com/";

	/** Performs lookup on MAC address(es) supplied in arguments.
	 * @param args MAC address(es) to lookup. */
	public static void main(String[] args) {
		for (String arguments : args)
			System.out.println(arguments + ": " + get(arguments));
	}

	/** Performs lookup on supplied MAC address.
	 * @param macAddress MAC address to lookup.
	 * @return Manufacturer of MAC address. */
	private static String get(String macAddress) {
		try {
			StringBuilder result = new StringBuilder();
			URL url = new URL(baseURL + macAddress);
			HttpURLConnection conn = (HttpURLConnection) url.openConnection();
			conn.setRequestMethod("GET");
			BufferedReader rd = new BufferedReader(new InputStreamReader(conn.getInputStream()));
			String line;
			while ((line = rd.readLine()) != null) {
				result.append(line);
			}
			rd.close();
			return result.toString();
		} catch (FileNotFoundException e) {
			// MAC not found
			return "N/A";
		} catch (IOException e) {
			// Error during lookup, either network or API.
			return null;
		}
	}
}


var mac = "88:53:2E:67:07:BE";
function findmac(){
	window.open("http://api.macvendors.com/" + mac);
}

findmac();


# v0.6.0

using Requests

function getvendor(addr::String)
    try
        get("http://api.macvendors.com/$addr") |> readstring
    catch e
        nothing
    end
end

for addr in ["88:53:2E:67:07:BE", "FC:FB:FB:01:FA:21", "D4:F4:6F:C9:EF:8D", "23:45:67"]
    println("$addr -> ", getvendor(addr))
end


// version 1.1.2

import java.net.URL

fun lookupVendor(mac: String) = URL("http://api.macvendors.com/" + mac).readText()

fun main(args: Array<String>) {
    val macs = arrayOf("FC-A1-3E", "FC:FB:FB:01:FA:21", "88:53:2E:67:07:BE", "D4:F4:6F:C9:EF:8D")
    for (mac in macs) println(lookupVendor(mac))
}


-- Requires LuaSocket extension by Lua
-- Created by James A. Donnell Jr.
-- www.JamesDonnell.com

local baseURL = "http://api.macvendors.com/"

local function lookup(macAddress)
	http = require "socket.http"
	result, statuscode, content = http.request(baseURL .. macAddress)
	return result
end

local macAddress = "FC-A1-3E-2A-1C-33"
print(lookup(macAddress))


Module Checkit {
      httpGet$=lambda$  (url$, timeout=500)->{
            declare htmldoc "WinHttp.WinHttpRequest.5.1"
            Method htmldoc "SetTimeouts", timeout, timeout, timeout, timeout
            Method htmldoc "open","GET", url$, false
            Method htmldoc "setRequestHeader","Content-Type", "application/x-www-form-urlencoded"
            Method htmldoc "send"
            With  htmldoc, "responseText" as ready$
            res$=trim$(ready$)
            if left$(res$,1)="{" then
                  ="N/A"
            else
                   =res$
            end if
            declare htmldoc nothing
      }
       Urls=("88:53:2E:67:07:BE", "FC:FB:FB:01:FA:21", "D4:F4:6F:C9:EF:8D", "23:45:67")
       url=each(URLs)
       While Url {
             Print Array$(URL), httpGet$("http://api.macvendors.com/"+Array$(URL))
             Wait 20
      }
}
Checkit


macLookup[mac_String] := Quiet[Check[Import["http://api.macvendors.com/" <> mac], "N/A"]]


import httpclient

for mac in ["FC-A1-3E", "FC:FB:FB:01:FA:21", "BC:5F:F4"]:
  echo newHttpClient().getContent("http://api.macvendors.com/"&mac)


(* build with ocamlfind ocamlopt -package netclient -linkpkg macaddr.ml -o macaddr *)

open Printf
open Nethttp_client.Convenience
open Unix

(* example vendors, including a nonsense one *)

let vendors = ["FF:FF:FF:67:07:BE"; "D4:F4:6F:C9:EF:8D"; "FC:FB:FB:01:FA:21"; "88:53:2E:67:07:BE"]

let get_vendor addr =
  sleep 3; (* built-in delay to handle rate-limiting at macvendors.com *)

  let client = http_get_message ("http://api.macvendors.com/" ^ addr) in
  match client # response_status_code with
  | 200 -> client # response_body # value
  | 404 -> "N/A"
  | _ -> "NULL"

let rec parse_vendors vendors =
  match vendors with
  | [] -> []
  | hd::tl -> get_vendor hd :: parse_vendors tl

let rec print_vendors vendor_list =
  match vendor_list with
  | [] -> ""
  | hd::tl -> printf "%s\n" hd; print_vendors tl

let main =
  let vendor_list = parse_vendors vendors in
  print_vendors vendor_list


#!/usr/bin/env perl -T
use 5.018_002;
use warnings;
use LWP;

our $VERSION = 1.000_000;

my $ua = LWP::UserAgent->new;

my @macs = (
    'FC-A1-3EFC:FB:FB:01:FA:21', '00,0d,4b',
    'Rhubarb',                   '00-14-22-01-23-45',
    '10:dd:b1',                  'D4:F4:6F:C9:EF:8D',
    'FC-A1-3E',                  '88:53:2E:67:07:BE',
    '23:45:67',                  'FC:FB:FB:01:FA:21',
    'BC:5F:F4',
);

for my $mac (@macs) {
    my $vendor = get_mac_vendor($mac);
    if ($vendor) {
        say "$mac = $vendor";
    }
}

sub get_mac_vendor {
    my $s = shift;

    my $req = HTTP::Request->new( GET => "http://api.macvendors.com/$s" );
    my $res = $ua->request($req);

    # A error related to the network connectivity or the API should
    # return a null result.
    if ( $res->is_error ) {
        return;
    }

    # A MAC address that does not return a valid result should
    # return the String "N/A".
    if (  !$res->content
        or $res->content eq 'Vendor not found' )
    {
        return 'N/A';
    }

    return $res->content;
}

# IEEE 802:
#  Six groups of two hexadecimal digits separated by hyphens or colons,
#    like 01-23-45-67-89-ab or 01:23:45:67:89:ab
#  Three groups of four hexadecimal digits separated by dots (.),
#    like 0123.4567.89ab
#sub validmac {
#    my $s = shift;
#
#    my $hex    = qr{ [A-Fa-f[:digit:]] }xms;
#    my $hex2ws = qr{ [-:] $hex{2} }xms;
#
#    if (   $s =~ m{\A $hex{2} $hex2ws{5} \z}xms
#        or $s =~ m{\A $hex{4} [.] $hex{4}  [.] $hex{4} \z}xms )
#    {
#        return 'true';
#    }
#    return;
#}


without js -- libcurl
string test = "00-11-22-33-44-55-66"     -- CIMSYS Inc
--string test = "10-11-22-33-44-55-66"      -- N/A
include builtins/libcurl.e
curl_global_init()
atom curl = curl_easy_init()
string url = sprintf("http://api.macvendors.com/%s",{test})
curl_easy_setopt(curl, CURLOPT_URL, url)
object res = curl_easy_perform_ex(curl)
if string(res) then
    if res="Vendor not found"
    or res=`{"errors":{"detail":"Not Found"}}` then
        res = "N/A"
    end if
    ?res
else
    ?{"error",res}
end if
curl_easy_cleanup(curl)
curl_global_cleanup()


(load "@lib/http.l")

(de maclookup (M)
   (client "api.macvendors.com" 80
      M
      (while (line))
      (line T) ) )
(test
   "Intel Corporate"
   (maclookup "88:53:2E:67:07:BE") )
(test
   "Apple, Inc."
   (maclookup "D4:F4:6F:C9:EF:8D") )


import requests

for addr in ['88:53:2E:67:07:BE', 'FC:FB:FB:01:FA:21',
        'D4:F4:6F:C9:EF:8D', '23:45:67']:
    vendor = requests.get('http://api.macvendors.com/' + addr).text
    print(addr, vendor)


#lang racket

(require net/url)

(define (lookup-MAC-address addr)
  (port->string
   (get-pure-port
    (url "http" #f "api.macvendors.com" #f #t (list (path/param addr null)) null #f))))

(module+ test
(for ((i (in-list '("88:53:2E:67:07:BE"
                    "FC:FB:FB:01:FA:21"
                    "D4:F4:6F:C9:EF:8D"))))
  (printf "~a\t~a~%" i (lookup-MAC-address i))))


use HTTP::UserAgent;

my $ua = HTTP::UserAgent.new;

$ua.timeout = 10; # seconds

my $server = 'http://api.macvendors.com/';

sub lookup ($mac) {
    my $response = $ua.get: "$server+$mac";
    sleep 1;
    return $response.is-success ?? $response.content !! 'N/A';

    CATCH {             # Normally you would report some information about what
        default { Nil } # went wrong, but the task specifies to ignore errors.
    }
}

for <
BC:5F:F4
FC-A1-3E
10:dd:b1
00:0d:4b
23:45:67
> -> $mac { say lookup $mac }


print read rejoin [http://api.macvendors.com/ ask "MAC address: "]


/*REXX pgm shows a network device's manufacturer based on the Media Access Control addr.*/
win_command         = 'getmac'                   /*name of the Microsoft Windows command*/
win_command_options = '/v /fo list'              /*options  of     "        "       "   */
?3= 'Network Adapter:'                           /*search keywords for Network Adapter. */
?4= 'Physical Address:'                          /*   "       "     "  Physical Address.*/
upper ?3 ?4                                      /*uppercase in case for capitol letters*/
@.=;            @.0= 0                           /*just─in─case values for the keywords.*/
rc= 0                                            /*  "   "   "  value for the returnCode*/
address system win_command win_command_options   with   output stem @.  /*issue command.*/
if rc\==0  then do                               /*display an error if not successful.  */
                say
                say '***error*** from command: '     win_command     win_command_options
                say 'Return code was: '    rc
                say
                exit rc
                end
MACaddr=.                                        /*just─in─case value for the keyword.  */
maker=.                                          /*  "   "   "    "    "   "     "      */
           do j=1  for @.0;  $= @.j;  upper $    /*parse each of the possible responses.*/
           if left($, length(?3))=?3  then maker=   subword(@.j, 3)   /*is this the one?*/
           if left($, length(?4))=?4  then MACaddr= word(@.j, 3)      /* "   "   "   "  */
           end   /*k*/
                                                 /* [↑]  Now, display good or bad stuff.*/
if maker=. | MACaddr==.  then say 'MAC address manufacturer not found.'
                         else say 'manufacturer for MAC address  '  MACaddr "  is  " maker
exit 0                                           /*stick a fork in it,  we're all done. */


# Project: MAC Vendor Lookup

load "stdlib.ring"
macs = ["FC-A1-3E","FC:FB:FB:01:FA:21","88:53:2E:67:07:BE","D4:F4:6F:C9:EF:8D"]
for mac = 1 to len(macs)
     lookupvendor(macs[mac])
next

func lookupvendor(mac)
       url = download("api.macvendors.com/" + mac)
       see url + nl


require 'net/http'

arr = ['88:53:2E:67:07:BE', 'FC:FB:FB:01:FA:21', 'D4:F4:6F:C9:EF:8D', '23:45:67']

arr.each do |addr|
  vendor = Net::HTTP.get('api.macvendors.com', "/#{addr}/") rescue nil
  puts "#{addr}  #{vendor}"
end


extern crate reqwest;

use std::{thread, time};

fn get_vendor(mac: &str) -> Option<String> {
    let mut url = String::from("http://api.macvendors.com/");
    url.push_str(mac);
    let url_ref = &url;
    match reqwest::get(url_ref) {
        Ok(mut res) => match res.text() {
            Ok(text) => {
                if text.contains("Not Found") {
                    Some("N/A".to_string())
                } else {
                    Some(text)
                }
            }
            Err(e) => {
                println!("{:?}", e);
                None
            }
        },
        Err(e) => {
            println!("{:?}", e);
            None
        }
    }
}

fn main() {
    let duration = time::Duration::from_millis(1000);
    match get_vendor("88:53:2E:67:07:BE") {
        None => println!("Error!"),
        Some(text) => println!("{}", text),
    }
    thread::sleep(duration);
    match get_vendor("FC:FB:FB:01:FA:21") {
        None => println!("Error!"),
        Some(text) => println!("{}", text),
    }
    thread::sleep(duration);
    match get_vendor("FC-A1-3E") {
        None => println!("Error!"),
        Some(text) => println!("{}", text),
    }
    thread::sleep(duration);
    match get_vendor("abcdefg") {
        None => println!("Error!"),
        Some(text) => println!("{}", text),
    }
}


object LookUp extends App {
  val macs = Seq("FC-A1-3E", "FC:FB:FB:01:FA:21", "88:53:2E:67:07:BE", "D4:F4:6F:C9:EF:8D")

  def lookupVendor(mac: String) =
    scala.io.Source.fromURL("""http://api.macvendors.com/""" + mac, "UTF-8").mkString

  macs.foreach(mac => println(lookupVendor(mac)))
}


package require http

# finally is a bit like go's defer
proc finally args {
    tailcall trace add variable :#finally#: unset [list apply [list args $args]]
}

# basic wrapper for http::geturl
proc geturl {url} {
    set tok [::http::geturl $url]
    finally ::http::cleanup $tok
    ::http::data $tok
}
proc maclookup {mac} {
    geturl http://api.macvendors.com/$mac
}

foreach mac {00-14-22-01-23-45 88:53:2E:67:07:BE} {
    puts "$mac\t[maclookup $mac]"
}


a=array("00-20-6b-ba-d0-cb","00-40-ae-04-87-86")
set WebRequest = CreateObject("WinHttp.WinHttpRequest.5.1")

for each MAC in a
  if b<>0 then   wscript.echo "Spacing next request...": wscript.sleep 2000
  WebRequest.Open "GET", "http://api.macvendors.com/"& mac,1
  WebRequest.Send()
  WebRequest.WaitForResponse
  b=b+1
  wscript.echo mac & " -> " & WebRequest.ResponseText
next


/* mac_vendor_lookup.wren */
class MAC {
    foreign static lookup(address)
}

System.print(MAC.lookup("FC:FB:FB:01:FA:21"))
for (i in 1..1e8) {} // slow down request
System.print(MAC.lookup("23:45:67"))


var [const] CURL=Import("zklCurl");   // libcurl
const MAC_VENDORS="http://api.macvendors.com/";

fcn lookUp(macAddress){
   httpAddr:=MAC_VENDORS + macAddress;
   vender:=CURL().get(httpAddr); //-->(Data,bytes of header,bytes of trailer)
   vender=vender[0].del(0,vender[1]);  // remove HTTP header
   vender.text;		// Data --> String (Data is a byte bucket)
}


program: mac_vendor_lookup

data: 'http://api.macvendors.com/'

input: 'D4:F4:6F:C9:EF:8D'
derive: 'http://api.macvendors.com/D4:F4:6F:C9:EF:8D'
output: 'Apple, Inc.'


DEFINE ADC="$6D"
DEFINE CLC="$18"
DEFINE JSR="$20"
DEFINE LDA="$AD"
DEFINE RTS="$60"
DEFINE STA="$8D"

PROC Main()
  BYTE ARRAY buf(20)
  BYTE a=[19],b=[37],s
  CARD addr

  addr=buf
  Poke(addr,CLC) addr==+1
  Poke(addr,LDA) addr==+1
  PokeC(addr,@a) addr==+2
  Poke(addr,ADC) addr==+1
  PokeC(addr,@b) addr==+2
  Poke(addr,STA) addr==+1
  PokeC(addr,@s) addr==+2
  Poke(addr,RTS) addr==+1

  [JSR buf] ;run the machine code stored on buf

  PrintF("%B+%B=%B%E",a,b,s)
RETURN


MCode(Var, "8B44240403442408C3")
MsgBox, % DllCall(&Var, "Char",7, "Char",12)
Var := ""
return

; http://www.autohotkey.com/board/topic/19483-machine-code-functions-bit-wizardry/
MCode(ByRef code, hex) { ; allocate memory and write Machine Code there
   VarSetCapacity(code, StrLen(hex) // 2)
   Loop % StrLen(hex) // 2
      NumPut("0x" . SubStr(hex, 2 * A_Index - 1, 2), code, A_Index - 1, "Char")
}


      REM Claim 9 bytes of memory
      SYS "GlobalAlloc",0,9 TO code%

      REM Poke machine code into it
      P%=code%
      [OPT 0
      mov EAX, [ESP+4]
      add EAX, [ESP+8]
      ret
      ]

      REM Run code
      SYS code%,7,12 TO result%
      PRINT result%

      REM Free memory
      SYS "GlobalFree",code%
      END


#include <stdio.h>
#include <sys/mman.h>
#include <string.h>

int test (int a, int b)
{
  /*
       mov EAX, [ESP+4]
       add EAX, [ESP+8]
       ret
  */
  char code[] = {0x8B, 0x44, 0x24, 0x4, 0x3, 0x44, 0x24, 0x8, 0xC3};
  void *buf;
  int c;
  /* copy code to executable buffer */
  buf = mmap (0,sizeof(code),PROT_READ|PROT_WRITE|PROT_EXEC,
             MAP_PRIVATE|MAP_ANON,-1,0);

  memcpy (buf, code, sizeof(code));
  /* run code */
  c = ((int (*) (int, int))buf)(a, b);
  /* free buffer */
  munmap (buf, sizeof(code));
  return c;
}

int main ()
{
  printf("%d\n", test(7,12));
  return 0;
}


pushq	%rbp
movq	%rsp, %rbp
movl	%edi, -0x4(%rbp)
movl	%esi, -0x8(%rbp)
movl	-0x4(%rbp), %esi
addl	-0x8(%rbp), %esi
movl	%esi, -0xc(%rbp)
movl	-0xc(%rbp), %eax
popq	%rbp
retq


;;Note that by using the 'CFFI' library, one can apply this procedure portably in any lisp implementation;
;; in this code however I chose to demonstrate only the implementation-dependent programs.

;;CCL
;; Allocate a memory pointer and poke the opcode into it
(defparameter ptr (ccl::malloc 9))

(loop for i in '(139 68 36 4 3 68 36 8 195)
   for j from 0 do
   (setf (ccl::%get-unsigned-byte ptr j) i))

;; Execute with the required arguments and return the result as an unsigned-byte
(ccl::ff-call ptr :UNSIGNED-BYTE 7 :UNSIGNED-BYTE 12 :UNSIGNED-BYTE)

;; Output = 19

;; Free the pointer
(ccl::free ptr)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;SBCL
(defparameter mmap (list 139 68 36 4 3 68 36 8 195))

(defparameter pointer (sb-alien:make-alien sb-alien:unsigned-char (length mmap)))

(defparameter callp (loop for byte in mmap
                          for i from 0
		       do
		       (setf (sb-alien:deref pointer i) byte)
		       finally
		       (return (sb-alien:cast pointer (function integer integer integer)))))

(sb-alien:alien-funcall callp 7 12)

(loop for i from 0 below 18 collect (sb-alien:deref ptr i))

(sb-alien:free-alien pointer)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;CLISP
(defparameter mmap (list 139 68 36 4 3 68 36 8 195))

(defparameter POINTER (FFI:FOREIGN-ADDRESS  (FFI:FOREIGN-ALLOCATE 'FFI:UINT8 :COUNT 9)))

(loop for i in mmap
   for j from 0 do
   (FUNCALL #'(SETF FFI:MEMORY-AS) i POINTER 'FFI:INT j))

(FUNCALL
 (FFI:FOREIGN-FUNCTION POINTER
		       (LOAD-TIME-VALUE
			(FFI:PARSE-C-TYPE
			 '(FFI:C-FUNCTION (:ARGUMENTS 'FFI:INT 'FFI:INT) (:RETURN-TYPE FFI:INT) (:LANGUAGE :STDC)))))
 7 12)

(FFI:FOREIGN-FREE POINTER)


include "cowgol.coh";

# Run machine code at cptr, given two 32-bit arguments,
# return the value returned from EAX.
sub RunCode(cptr: [uint8], arg1: uint32, arg2: uint32): (rslt: uint32) is
    # Inline assembly is supported, so this whole rigmarole
    # is not even necessary.
    # Though note that this (obviously) depends on the assembly back-end used.
    # Linux as uses AT&T syntax, so that's what I'm doing here.
    # Cowgol supports many processors but this will, obviously, only work
    # on x86.

    @asm "pushl (",arg1,")";      # Push the two arguments on the stack
    @asm "pushl (",arg2,")";
    @asm "call *(",cptr,")";      # Call the code at the pointer
    @asm "movl %eax, (",rslt,")"; # Store the result in rslt
    @asm "popl %eax";             # Clean up the stack
    @asm "popl %eax";
end sub;

# Store code in an array. This is enough to make it available.
var code: uint8[] := {139, 68, 36, 4, 3, 68, 36, 8, 195};

# Use the function
print_i32(RunCode(&code as [uint8], 7, 12)); # this prints 7+12 = 19
print_nl();

# As a demonstration, this shows it can be patched at runtime to multiply instead
code[4] := 247;
code[5] := 100;
print_i32(RunCode(&code as [uint8], 7, 12)); # this prints 7*12 = 84
print_nl();


int test(in int a, in int b) pure nothrow @nogc {
    /*
    mov EAX, [ESP+4]
    add EAX, [ESP+8]
    ret
    */
    immutable ubyte[9] code = [0x8B, 0x44, 0x24, 0x4, 0x3, 0x44, 0x24, 0x8, 0xC3];
    alias F = extern(C) int function(int, int) pure nothrow @nogc;
    immutable f = cast(F)code.ptr;
    return f(a, b); // Run code.
}

void main() {
    import std.stdio;

    test(7, 12).writeln;
}


/* 8080 machine code in an array */
[6] byte add_mc = (
    0xC1,           /* POP B - get return address */
    0xD1,           /* POP D - get second argument */
    0xE1,           /* POP H - get first argument */
    0x19,           /* DAD D - add arguments */
    0xC5,           /* PUSH B - push return address back */
    0xC9            /* RET - return */
);

proc nonrec main() void:
    /* Declare a function pointer */
    type fn = proc(word a, b) word;
    fn add;

    /* Pretend the array is actually a function */
    add := pretend(add_mc, fn);

    /* Call the function and print the result */
    writeln(add(12, 7))
corp


'' This is an example for the x86 architecture.
Function test (Byval a As Long, Byval b As Long) As Long
    Asm
        mov eax, [a]
        Add eax, [b]
        mov [Function], eax
    End Asm
End Function

Print test(12, 7)
Sleep


package main

import "fmt"

/*
#include <stdio.h>
#include <stdlib.h>
#include <sys/mman.h>
#include <string.h>

typedef unsigned char byte;
typedef byte (*mcfunc) (byte, byte);

void runMachineCode(void *buf, byte a, byte b) {
    mcfunc fp = (mcfunc)buf;
    printf("%d\n", fp(a, b));
}
*/
import "C"

func main() {
    code := []byte{
        0x55, 0x48, 0x89, 0xe5, 0x89, 0x7d,
        0xfc, 0x89, 0x75, 0xf8, 0x8b, 0x75,
        0xfc, 0x03, 0x75, 0xf8, 0x89, 0x75,
        0xf4, 0x8b, 0x45, 0xf4, 0x5d, 0xc3,
    }
    le := len(code)
    buf := C.mmap(nil, C.size_t(le), C.PROT_READ|C.PROT_WRITE|C.PROT_EXEC,
        C.MAP_PRIVATE|C.MAP_ANON, -1, 0)
    codePtr := C.CBytes(code)
    C.memcpy(buf, codePtr, C.size_t(le))
    var a, b byte = 7, 12
    fmt.Printf("%d + %d = ", a, b)
    C.runMachineCode(buf, C.byte(a), C.byte(b))
    C.munmap(buf, C.size_t(le))
    C.free(codePtr)
}


using Cxx

cxx"""
#include <stdio.h>
#include <sys/mman.h>
#include <string.h>

int test (int a, int b)
{
  /*
       mov EAX, [ESP+4]
       add EAX, [ESP+8]
       ret
  */
  char code[] = {0x8B, 0x44, 0x24, 0x4, 0x3, 0x44, 0x24, 0x8, 0xC3};
  void *buf;
  int c;
  /* copy code to executable buffer */
  buf = mmap (0,sizeof(code),PROT_READ|PROT_WRITE|PROT_EXEC,
             MAP_PRIVATE|MAP_ANON,-1,0);

  memcpy (buf, code, sizeof(code));
  /* run code */
  c = ((int (*) (int, int))buf)(a, b);
  /* free buffer */
  munmap (buf, sizeof(code));
  return c;
}

int main ()
{
  printf("%d\n", test(7,12));
  return 0;
}
"""

julia_function = @cxx main()
julia_function()


// mcode.def
---

static inline unsigned char runMachineCode(void *code, unsigned char a, unsigned char b) {
    return ((unsigned char (*) (unsigned char, unsigned char))code)(a, b);
}


Module Checkit {
      Buffer DataMem as Long*10
      Return DataMem, 1:=500    ' second Long
      Print Eval(DataMem, 1)+5100+5=5605
      \\ Now we do math executing machine code
      Buffer Code ExecMem as byte*1024
      Address=0
      EmbLong(0xb8, 5100) ' mov eax,5100
      EmbByteByte(0x83, 0xC0, 5) ' add  eax,0x5
      EmbByteLong(0x3,0x5, DataMem(1)) ' add eax, [DataMem(1)]
      EmbLong(0xa3, DataMem(0)) ' mov [DataMem(0)], eax
      \\ split rem to execute xor eax eax (eax=0)
      Rem : EmbByte(0x31, 0xC0) ' xor eax, eax
      Ret() ' Return
      \\
      Try ok {
            Execute Code ExecMem, 0
      }
      \\If  Eax <>0 then we get error, so we read error as Uint()
      \\ Error read once then change to zero
      m=Uint(Error)
      \\ Hex is Print Hexadecimal for unsigned numbers
      Hex m
      Print m=5605
      Print Error=0, ok=False

      Print Eval(DataMem, 0)=5605,  Eval(DataMem, 0)
      \\ sub used as Exit here
      Sub Ret()
            Return ExecMem, Address:=0xC3
            Address++
      End Sub
      Sub EmbByteByte()
            Return ExecMem, Address:=Number, Address+1:=Number, Address+2:=Number
            Address+=3
      End Sub
      Sub EmbByte()
            Return ExecMem, Address:=Number, Address+1:=Number
            Address+=2
      End Sub
      Sub EmbLong()
            Return ExecMem, Address:=Number, Address+1:=Number as Long
            Address+=5
      End Sub
      Sub EmbByteLong()
            Return ExecMem, Address:=Number, Address+1:=Number, Address+2:=Number as Long
            Address+=6
      End Sub

}
CheckIt


import posix

let MAP_ANONYMOUS {.importc: "MAP_ANONYMOUS", header: "<sys/mman.h>".}: cint

proc test(a, b: cint): cint =
  # mov EAX, [ESP+4]
  # add EAX, [ESP+8]
  # ret
  var code = [0x8B'u8, 0x44, 0x24, 0x4, 0x3, 0x44, 0x24, 0x8, 0xC3]

  # create an executable buffer
  var buf = mmap(nil, sizeof(code), PROT_READ or PROT_WRITE or PROT_EXEC,
    MAP_PRIVATE or MAP_ANONYMOUS, -1, 0)

  # copy code to the buffer
  copyMem(buf, addr code[0], sizeof(code))
  # run code
  result = cast[proc(a, b: cint): cint {.nimcall.}](buf)(a, b)
  # free buffer
  discard munmap(buf, sizeof(code))

echo test(7, 12)


#include <stdio.h>
#include <sys/mman.h>
#include <string.h>
#include <pari/pari.h>

int
test(int a, int b)
{
  char code[] = {0x8B, 0x44, 0x24, 0x4, 0x3, 0x44, 0x24, 0x8, 0xC3};
  void *buf;
  int c;
  /* copy code to executable buffer */
  buf = mmap (0,sizeof(code),PROT_READ|PROT_WRITE|PROT_EXEC,
             MAP_PRIVATE|MAP_ANON,-1,0);

  memcpy (buf, code, sizeof(code));
  /* run code */
  c = ((int (*) (int, int))buf)(a, b);
  /* free buffer */
  munmap (buf, sizeof(code));
  return c;
}

void
init_auto(void)
{
  pari_printf("%d\n", test(7,12));
  return 0;
}


Program Example66;
{Inspired... program to demonstrate the MMap function. Freepascal docs }
Uses
  BaseUnix,Unix;

const
  code : array[0..9] of byte = ($8B, $44, $24, $4, $3, $44, $24, $8, $C3, $00);
  a :longInt= 12;
  b :longInt=  7;
type
  tDummyFunc = function(a,b:LongInt):LongInt;cdecl;
Var
    Len,k  : cint;
    P    : Pointer;

begin
  len := sizeof(code);
  P:= fpmmap(nil,
             len+1 ,
             PROT_READ OR PROT_WRITE OR PROT_EXEC,
             MAP_ANONYMOUS OR MAP_PRIVATE,
             -1, // for MAP_ANONYMOUS
             0);
  If P =  Pointer(-1) then
    Halt(4);

  for k := 0 to len-1 do
    pChar(p)[k] := char(code[k]);

  k := tDummyFunc(P)(a,b);

  Writeln(a,'+',b,' = ',k);
  if fpMUnMap(P,Len)<>0 Then
    Halt(fpgeterrno);
end.


atom mem = allocate(9)
poke(mem,{#8B,#44,#24,#04,#03,#44,#24,#08,#C3})
constant mfunc = define_c_func({},mem,{C_INT,C_INT},C_INT)
?c_func(mfunc,{12,7})
free(mem)


(setq P
   (struct (native "@" "malloc" 'N 39) 'N
      # Align
      144                  # nop
      144                  # nop

      # Prepare stack
      106 12               # pushq $12
      184 7 0 0 0          # mov $7, %eax
      72 193 224 32        # shl $32, %rax
      80                   # pushq %rax

      # Rosetta task code
      139 68 36 4 3 68 36 8

      # Get result
      76 137 227           # mov %r12, %rbx
      137 195              # mov %eax, %ebx
      72 193 227 4         # shl $4, %rbx
      128 203 2            # orb $2, %bl

      # Clean up stack
      72 131 196 16        # add $16, %rsp

      # Return
      195 )                # ret
   foo (>> 4 P) )

# Execute
(println (foo))

# Free memory
(native "@" "free" NIL P)


100H:

/* 8080 MACHINE CODE TO ADD TWO BYTES:
   79       MOV A,C     ; LOAD FIRST ARG INTO ACCUMULATOR
   83       ADD E       ; ADD SECOND ARG TO ACCUMULATOR
   C9       RET         ; RETURN */

DECLARE ADD$8080 DATA (79H, 83H, 0C9H);

/* THE 8080 PL/M CALLING CONVENTION IS THAT THE
   NEXT-TO-LAST ARG IS PUT IN (B)C, THE LAST ARG IN (D)E.
   (THE REST ARE IN MEMORY BUT WE DO NOT NEED ANY MORE.)
   THE RETURN ARGUMENT SHOULD BE IN THE ACCUMULATOR.
   WE CAN DEFINE A WRAPPER PROCEDURE TO DECLARE THE
   TYPES OF THE ARGUMENTS. */

EXEC$ADD: PROCEDURE (A,B) BYTE;
    DECLARE (A,B) BYTE;
    /* WE CAN 'GO TO' CONSTANTS OR VARIABLES, BUT NOT TO
       EXPRESSIONS. SO WE HAVE TO FETCH THE ADDRESS FIRST. */
    DECLARE LOC ADDRESS;
    LOC = .ADD$8080;
    GO TO LOC;
END EXEC$ADD;

/* IN FACT, PL/M DOES NOT COME WITH ANY STANDARD LIBARIES.
   IT IS FROM BEFORE THE TIME THAT YOU COULD ASSUME THERE
   WOULD EVEN BE AN OPERATING SYSTEM, THOUGH CP/M
   (THE PREDECESSOR TO DOS) WOULD QUICKLY BECOME STANDARD.

   WE NEED TO USE THIS EXACT TRICK TO GET CP/M TO PRINT THE
   RESULT TO THE OUTPUT. LUCKILY (AND NOT COINCIDENTALLY),
   THE CP/M SYSCALL ENTRY POINT IS COMPATIBLE WITH THE
   PL/M CALLING CONVENTION. */

BDOS: PROCEDURE (FUNC, ARG);
    DECLARE FUNC BYTE;
    DECLARE ARG ADDRESS;
    /* 5 IS THE CP/M BDOS ENTRY POINT */
    GO TO 5;
END BDOS;

/* WE ALSO NEED OUR OWN NUMBER OUTPUT ROUTINE. WE CAN WRITE
   IT IN PL/M, THEN USE THE ABOVE ROUTINE TO TELL CP/M
   TO PRINT THE RESULT. */

PRINT$NUMBER: PROCEDURE(N);
    DECLARE S (4) BYTE INITIAL ('...$');
    DECLARE P ADDRESS;
    DECLARE (N, C BASED P) BYTE;

    /* EXTRACT EACH DIGIT AND WRITE THEM BACKWARDS TO A STRING */
    P = .S(3);
DIGIT:
    P = P-1;
    C = (N MOD 10) + '0';
    N = N/10;
    IF N > 0 THEN GO TO DIGIT;

    /* TELL CP/M TO PRINT THE RESULTING STRING */
    CALL BDOS(9, P);
END PRINT$NUMBER;

/* USING OUR OWN MACHINE CODE WORKS IN THE SAME WAY */
CALL PRINT$NUMBER( EXEC$ADD( 7, 12) ); /* THIS PRINTS 19 */

CALL BDOS(0,0); /* EXIT */
EOF


CompilerIf #PB_Compiler_Processor <> #PB_Processor_x86
  CompilerError "Code requires a 32-bit processor."
CompilerEndIf

; Machine code using the Windows API

Procedure MachineCodeVirtualAlloc(a,b)
*vm = VirtualAlloc_(#Null,?ecode-?scode,#MEM_COMMIT,#PAGE_EXECUTE_READWRITE)
    If(*vm)
        CopyMemory(?scode, *vm, ?ecode-?scode)
        eax_result=CallFunctionFast(*vm,a,b)
        VirtualFree_(*vm,0,#MEM_RELEASE)
        ProcedureReturn eax_result
    EndIf
EndProcedure

rv=MachineCodeVirtualAlloc( 7, 12)
MessageRequester("MachineCodeVirtualAlloc",Str(rv)+Space(50),#PB_MessageRequester_Ok)

#HEAP_CREATE_ENABLE_EXECUTE=$00040000

Procedure MachineCodeHeapCreate(a,b)
hHeap=HeapCreate_(#HEAP_CREATE_ENABLE_EXECUTE,?ecode-?scode,?ecode-?scode)
    If(hHeap)
        CopyMemory(?scode, hHeap, ?ecode-?scode)
        eax_result=CallFunctionFast(hHeap,a,b)
        HeapDestroy_(hHeap)
        ProcedureReturn eax_result
    EndIf
EndProcedure

rv=MachineCodeHeapCreate(7,12)
MessageRequester("MachineCodeHeapCreate",Str(rv)+Space(50),#PB_MessageRequester_Ok)
End

; 8B442404               mov     eax,[esp+4]
; 03442408               add     eax,[esp+8]
; C20800                 ret     8

DataSection
scode:
Data.a $8B,$44,$24,$04,$03,$44,$24,$08,$C2,$08,$00
ecode:
EndDataSection


import ctypes
import os
from ctypes import c_ubyte, c_int

code = bytes([0x8b, 0x44, 0x24, 0x04, 0x03, 0x44, 0x24, 0x08, 0xc3])

code_size = len(code)
# copy code into an executable buffer
if (os.name == 'posix'):
    import mmap
    executable_map = mmap.mmap(-1, code_size, mmap.MAP_PRIVATE | mmap.MAP_ANON, mmap.PROT_READ | mmap.PROT_WRITE | mmap.PROT_EXEC)
    # we must keep a reference to executable_map until the call, to avoid freeing the mapped memory
    executable_map.write(code)
    # the mmap object won't tell us the actual address of the mapping, but we can fish it out by allocating
    # some ctypes object over its buffer, then asking the address of that
    func_address = ctypes.addressof(c_ubyte.from_buffer(executable_map))
elif (os.name == 'nt'):
    # the mmap module doesn't support protection flags on Windows, so execute VirtualAlloc instead
    code_buffer = ctypes.create_string_buffer(code)
    PAGE_EXECUTE_READWRITE = 0x40  # Windows constants that would usually come from header files
    MEM_COMMIT = 0x1000
    executable_buffer_address = ctypes.windll.kernel32.VirtualAlloc(0, code_size, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    if (executable_buffer_address == 0):
        print('Warning: Failed to enable code execution, call will likely cause a protection fault.')
        func_address = ctypes.addressof(code_buffer)
    else:
        ctypes.memmove(executable_buffer_address, code_buffer, code_size)
        func_address = executable_buffer_address
else:
    # for other platforms, we just hope DEP isn't enabled
    code_buffer = ctypes.create_string_buffer(code)
    func_address = ctypes.addressof(code_buffer)

prototype = ctypes.CFUNCTYPE(c_int, c_ubyte, c_ubyte) # build a function prototype from return type and argument types
func = prototype(func_address)                        # build an actual function from the prototype by specifying the address
res = func(7,12)
print(res)


/O> ( check that + and negate are operators (i.e. op-codes )
... ' + operator? ' negate operator? and if [ say "true"]
...
true
Stack empty.

/O> ( create a memory block large enough to hold them, )
... ( filled with zeros )
... 0 2 of
...

Stack: [ 0 0 ]

/O> ( poke the + operator into place )
... ' + swap 0 poke
...

Stack: [ + 0 ]

/O> ( poke the negate operator into place )
... ' negate swap 1 poke
...

Stack: [ + negate ]

/O> ( Using the phrase               )
... (                                )
... (     ' +  ' negate  join        )
... (                                )
... ( would be more idiomatic, but   )
... ( the task specifies poking.     )

Stack: [ + negate ]

/O> ( now put two numbers underneath it on the stack )
... 7 12 rot
...

Stack: 7 12 [ + negate ]

/O> ( and run the machine code )
... do
...

Stack: -19

/O> ( ta-da! )


#lang racket/base

(require ffi/unsafe)

; set up access to racket internals
(define scheme-malloc-code
  (get-ffi-obj 'scheme_malloc_code #f (_fun (len : _intptr) -> _pointer)))
(define scheme-free-code
  (get-ffi-obj 'scheme_free_code #f (_fun _pointer -> _void)))

(define opcodes '(139 68 36 4 3 68 36 8 195))

(define code (scheme-malloc-code 64))

(for ([byte opcodes]
      [i (in-naturals)])
  (ptr-set! code _ubyte i byte))

(define function (cast code _pointer (_fun _ubyte _ubyte -> _ubyte)))

(function 7 12)

(scheme-free-code code)


extern crate libc;

#[cfg(all(
    target_os = "linux",
    any(target_pointer_width = "32", target_pointer_width = "64")
))]
fn main() {
    use std::mem;
    use std::ptr;

    let page_size: usize = 4096;
    let (bytes, size): (Vec<u8>, usize) = if cfg!(target_pointer_width = "32") {
        (
            vec![0x8b, 0x44, 0x24, 0x04, 0x03, 0x44, 0x24, 0x08, 0xc3],
            9,
        )
    } else {
        (vec![0x48, 0x89, 0xf8, 0x48, 0x01, 0xf0, 0xc3], 7)
    };
    let f: fn(u8, u8) -> u8 = unsafe {
        let mut page: *mut libc::c_void = ptr::null_mut();
        libc::posix_memalign(&mut page, page_size, size);
        libc::mprotect(
            page,
            size,
            libc::PROT_EXEC | libc::PROT_READ | libc::PROT_WRITE,
        );
        let contents: *mut u8 = page as *mut u8;
        ptr::copy(bytes.as_ptr(), contents, 9);
        mem::transmute(contents)
    };

    let return_value = f(7, 12);
    println!("Returned value: {}", return_value);
    assert_eq!(return_value, 19);
}

#[cfg(any(
    not(target_os = "linux"),
    not(any(target_pointer_width = "32", target_pointer_width = "64"))
))]
fn main() {
    println!("Not supported on this platform.");
}


!ExternalBytes class methods!

mapExecutableBytes:size
%{
#   include <sys/mman.h>

    void *mem;
    OBJ retVal;
    int nBytes = __intVal(size);

    mem = mmap(nil, nBytes, PROT_READ|PROT_WRITE|PROT_EXEC, MAP_PRIVATE|MAP_ANON, -1, 0);
    if (mem != MAP_FAILED) {
        RETURN( __MKEXTERNALBYTES_N(mem, nBytes));
    }
%}.
    self primitiveFailed
! !


import Foundation

typealias TwoIntsOneInt = @convention(c) (Int, Int) -> Int

let code = [
  144, // Align
  144,
  106, 12, // Prepare stack
  184, 7, 0, 0, 0,
  72, 193, 224, 32,
  80,
  139, 68, 36, 4, 3, 68, 36, 8, // Rosetta task code
  76, 137, 227, // Get result
  137, 195,
  72, 193, 227, 4,
  128, 203, 2,
  72, 131, 196, 16, // Clean up stack
  195, // Return
] as [UInt8]

func fudge(x: Int, y: Int) -> Int {
  let buf = mmap(nil, code.count, PROT_READ|PROT_WRITE|PROT_EXEC, MAP_PRIVATE|MAP_ANON, -1, 0)

  memcpy(buf, code, code.count)

  let fun = unsafeBitCast(buf, to: TwoIntsOneInt.self)
  let ret = fun(x, y)

  munmap(buf, code.count)

  return ret
}

print(fudge(x: 7, y: 12))


package require critcl

critcl::ccode {
    #include <sys/mman.h>
}

# Define a command using C. The C is embedded in Tcl, and will be
# built into a shared library at runtime. Note that Tcl does not
# provide a native way of doing this sort of thing; this thunk is
# mandatory.
critcl::cproc runMachineCode {Tcl_Obj* codeObj int a int b} int {
    int size, result;
    unsigned char *code = Tcl_GetByteArrayFromObj(codeObj, &size);
    void *buf;

    /* copy code to executable buffer */
    buf = mmap(0, (size_t) size, PROT_READ|PROT_WRITE|PROT_EXEC,
            MAP_PRIVATE|MAP_ANON, -1, 0);
    memcpy(buf, code, (size_t) size);
    /* run code */
    result = ((int (*) (int, int)) buf)(a, b);
    /* dispose buffer */
    munmap(buf, (size_t) size);

    return result;
}

# But now we have our thunk, we can execute arbitrary binary blobs
set code [binary format c* {0x8B 0x44 0x24 0x4 0x3 0x44 0x24 0x8 0xC3}]
puts [runMachineCode $code 7 12]


/* machine_code.wren */

class C {
    // pass the machine code in string form to the host
    foreign static runMachineCode(s, a, b)
}

var a = 7
var b = 12

// x64 opcodes for this task
var m = [
    0x55, 0x48, 0x89, 0xe5, 0x89, 0x7d,
    0xfc, 0x89, 0x75, 0xf8, 0x8b, 0x75,
    0xfc, 0x03, 0x75, 0xf8, 0x89, 0x75,
    0xf4, 0x8b, 0x45, 0xf4, 0x5d, 0xc3
]

var s = m.map { |byte| String.fromByte(byte) }.join()
System.print("%(a) + %(b) = %(C.runMachineCode(s, a, b))")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Linux Build:
;;   $ uasm -elf64 mexec.asm
;;   $ gcc -o mexec mexec.o -no-pie
;;  With MUSL libc
;;   $ musl-gcc -o mexec mexec.o -e main -nostartfiles -no-pie
;;
;; Windows Build:
;;   $ uasm64 -win64 mexec.asm
;;   $ link /machine:x64 /subsystem:console /release mexec.obj
;;         kernel32.lib msvcrt.lib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
option casemap:none
option literals:on

WIN64 equ 1
LIN64 equ 3

ifndef __MEMEXEC_CLASS__
__MEMEXEC_CLASS__ equ 1

  if @Platform eq WIN64
    option dllimport:<kernel32>
      HeapAlloc       proto fd:qword, flgs:dword, hlen:qword
      HeapFree        proto fd:qword, flgs:dword, lpmem:qword
      GetProcessHeap  proto
      ExitProcess     proto uexit:word
    option dllimport:<msvcrt>
      printf      proto fmt:qword, args:VARARG
      memcpy      proto d:qword, s:qword, mlen:qword
    option dllimport:none
      exit equ ExitProcess
  elseif @Platform eq LIN64
    malloc        proto SYSTEMV len:qword
    free          proto SYSTEMV m:qword
    printf        proto SYSTEMV fmt:qword, args:VARARG
    mprotect      proto SYSTEMV m:qword, s:qword, flgs:dword
    memcpy        proto SYSTEMV d:qword, s:qword, mlen:qword
    exit          proto SYSTEMV uexit:word

    PROT_READ     equ 01h
    PROT_WRITE    equ 02h
    PROT_EXEC     equ 04h
    PROT_NONE     equ 00h
    PROT_ALL      equ PROT_READ + PROT_WRITE + PROT_EXEC
  endif

  CLASS memexec
    CMETHOD run
  ENDMETHODS
    buff     db 048h, 089h, 0F8h         ;; mov rax, rdi
            db 048h, 001h, 0F0h         ;; add rax, rsi
            db 0C3h                     ;; ret
    mem     dq ?                        ;; Memory address
    mlen    dq 0                        ;; Memory size allocated?
  ENDCLASS

  pmemexec typedef ptr memexec

  METHOD memexec, Init, <VOIDARG>, <uses rcx>
    local tmp:qword

    mov rbx, thisPtr
    assume rbx:ptr memexec
    lea rdx, [rbx].buff
    invoke printf, CSTR("[mexec->Init] - bytecode addr: 0x%X",10), rdx
    mov tmp, rdx
    mov [rbx].mlen, sizeof(tmp)
    invoke printf, CSTR("[mexec->Init] - bytecode len: %i",10), [rbx].mlen
    ;; In Built memory allocator, used by the Class extention
    ;; Uses either HeapAlloc for windows or malloc for everything else.
    ;; Which is why I didn't use mmap in the first place.
    MEMALLOC([rbx].mlen)
    .if rax == -1
      invoke printf, CSTR("[exec->Init->Error] - Malloc failed with -1",10)
      mov rax, rbx
      ret
    .endif
    mov [rbx].mem, rax
    invoke printf, CSTR("[mexec->Init] - [rbx].mem addr: 0x%X",10), [rbx].mem
    ;; Memory wont be executable by default from Malloc, So we make it
    ;; so with mprotect. Not sure about windows, Might need to use a VirtualProtect
    ;; call..
    if @Platform eq LIN64
      invoke mprotect, [rbx].mem, [rbx].mlen, PROT_ALL
      .if rax == -1
        invoke printf, CSTR("[exec]-Init->Error] - mprotect failed with -1",10)
        mov rax, rbx
        ret
      .endif
    endif
    invoke printf, CSTR("[mexec->Init] Copying [rbx].buff bytecode to 0x%X",10), [rbx].mem
    invoke memcpy, [rbx].mem, addr [rbx].buff, [rbx].mlen
    .if rax == -1
      invoke printf, CSTR("[mexec->Init->Error] - memcpy failed with -l",10)
      mov rax, rbx
      ret
    .endif
    mov rcx, [rbx].mem
    mov rax, rbx
    assume rbx:nothing
    ret
  ENDMETHOD

  METHOD memexec, run, <VOIDARG>, <>, arg1:qword, arg2:qword
    mov rbx, thisPtr
    assume rbx:ptr memexec
    mov rdi, arg1
    mov rsi, arg2
    call [rbx].mem
    assume rbx:nothing
    ret
  ENDMETHOD

  METHOD memexec, Destroy, <VOIDARG>, <>
    mov rbx, thisPtr
    assume rbx:ptr memexec
    mov [rbx].mlen, 0
    MEMFREE([rbx].mem)
    assume rbx:nothing
    ret
  ENDMETHOD

endif      ;; __MEMEXEC_CLASS__
.data
a1   dq 7
a2   dq 12

.code
main proc
  local pmem:ptr memexec

  mov pmem, _NEW(memexec)
  pmem->run(a1,a2)
  invoke printf, CSTR("[pmem->run(%i, %i)] - returned: %i",10), a1, a2, rax
  _DELETE(pmem)
  invoke exit, 0
  ret
main endp

end


func Sum(A, B);         \Return sum of A+B
char A, B;
[asm {  ldrb r0, A
        ldrb r1, B
        add  r0, r1
        strb r0, A
     }
return A;
];

IntOut(0, Sum(7, 12))


F magic(n)
   L(row) 1..n
      print(((1..n).map(col -> @n * ((@row + col - 1 + @n I/ 2) % @n)
                                  + ((@row + 2 * col - 2) % @n) + 1)).map(cell -> String(cell).rjust(String(@n ^ 2).len)).join(‘ ’))
   print("\nAll sum to magic number #.".format((n * n + 1) * n I/ 2))

L(n) (5, 3, 7)
   print("\nOrder #.\n=======".format(n))
   magic(n)


*        Magic squares of odd order - 20/10/2015
MAGICS   CSECT
         USING  MAGICS,R15         set base register
         LA     R6,1               i=1
LOOPI    C      R6,N               do i=1 to n
         BH     ELOOPI
         LR     R8,R6              i
         SLA    R8,1               i*2
         LA     R9,PG              [email protected]
         LA     R7,1               j=1
LOOPJ    C      R7,N               do j=1 to n
         BH     ELOOPJ
         LR     R5,R8              i*2
         SR     R5,R7              -j
         A      R5,N               +n
         BCTR   R5,0               -1
         XR     R4,R4              clear high reg
         D      R4,N               /n
         LR     R5,R4              //n
         M      R4,N               *n
         LR     R2,R5              (i*2-j+n-1)//n*n
         LR     R5,R8              i*2
         AR     R5,R7              -j
         S      R5,=F'2'           -2
         XR     R4,R4              clear high reg
         D      R4,N               /n
         AR     R2,R4              +(i*2+j-2)//n
         LA     R2,1(R2)           +1
         XDECO  R2,PG+80           (i*2-j+n-1)//n*n+(i*2+j-2)//n+1
         MVC    0(5,R9),PG+87      put in buffer
         LA     R9,5(R9)           pgi=pgi+5
         LA     R7,1(R7)           j=j+1
         B      LOOPJ
ELOOPJ   XPRNT  PG,80
         LA     R6,1(R6)           i=i+1
         B      LOOPI
ELOOPI   XR     R15,R15            set return code
         BR     R14                return to caller
N        DC     F'9'               <== input
PG       DC     CL92' '            buffer
         YREGS
         END    MAGICS


with Ada.Text_IO, Ada.Command_Line;

procedure Magic_Square is
   N: constant Positive := Positive'Value(Ada.Command_Line.Argument(1));

   subtype Constants is Natural range 1 .. N*N;
   package CIO is new Ada.Text_IO.Integer_IO(Constants);
   Undef: constant Natural := 0;

   subtype Index is Natural range 0 .. N-1;
   function Inc(I: Index) return Index is (if I = N-1 then 0 else I+1);
   function Dec(I: Index) return Index is (if I = 0 then N-1 else I-1);

   A: array(Index, Index) of Natural := (others => (others => Undef));
     -- initially undefined; at the end holding the magic square

   X: Index := 0; Y: Index := N/2; -- start position for the algorithm
begin
   for I in Constants loop -- write 1, 2, ..., N*N into the magic array
      A(X, Y) := I; -- write I into the magic array
      if A(Dec(X), Inc(Y)) = Undef then
	 X := Dec(X); Y := Inc(Y); -- go right-up
      else
	 X := Inc(X); -- go down
      end if;
   end loop;

   for Row in Index loop -- output the magic array
      for Collumn in Index loop
	 CIO.Put(A(Row, Collumn),
		 Width => (if N*N < 10 then 2 elsif N*N < 100 then 3 else 4));
      end loop;
      Ada.Text_IO.New_Line;
   end loop;
end Magic_Square;


# construct a magic square of odd order                                      #
PROC magic square = ( INT order ) [,]INT:
    IF NOT ODD order OR order < 1
    THEN
        # can't make a magic square of the specified order                   #
        LOC [ 1 : 0, 1 : 0 ]INT
    ELSE
        # order is OK - construct the square using de la Loubère's           #
        # algorithm as in the wikipedia page                                 #

        [ 1 : order, 1 : order ]INT square;
        FOR i TO order DO FOR j TO order DO square[ i, j ] := 0 OD OD;

        # as square [ 1, 1 ] if the top-left, moving "up" reduces the row    #
        # operator to advance "up" the square                                #
        OP   PREV = ( INT pos )INT: IF pos = 1 THEN order ELSE pos - 1 FI;
        # operator to advance "across right" or "down" the square            #
        OP   NEXT = ( INT pos )INT: ( pos MOD order ) + 1;

        # fill in the square, starting from the middle of the top row        #
        INT col := ( order + 1 ) OVER 2;
        INT row := 1;
        FOR i TO order * order DO
            square[ row, col ] := i;
            IF square[ PREV row, NEXT col ] /= 0
            THEN
                # the up/right position is already taken, move down          #
                row := NEXT row
            ELSE
                # can move up and right                                      #
                row := PREV row;
                col := NEXT col
            FI
        OD;

        square
    FI # magic square # ;

# prints the magic square                                                    #
PROC print square = ( [,]INT square )VOID:
    BEGIN
        INT order = 1 UPB square;
        # calculate print width: negative so a leading "+" is not printed    #
        INT width := -1;
        INT mag   := order * order;
        WHILE mag >= 10 DO mag OVERAB 10; width MINUSAB 1 OD;
        # calculate the "magic sum"                                          #
        INT sum := 0;
        FOR i TO order DO sum +:= square[ 1, i ] OD;
        # print the square                                                   #
        print( ( "maqic square of order ", whole( order, 0 ), ": sum: ", whole( sum, 0 ), newline ) );
        FOR i TO order DO
            FOR j TO order DO write( ( " ", whole( square[ i, j ], width ) ) ) OD;
            write( ( newline ) )
        OD
    END # print square # ;

# test the magic square generation                                           #
FOR order BY 2 TO 7 DO print square( magic square( order ) ) OD


begin
    % construct a magic square of odd order - as a procedure can't return an %
    % array, the caller must supply one that is big enough                   %
    logical procedure magicSquare( integer array square ( *, * )
                                 ; integer value order
                                 ) ;
        if not odd( order ) or order < 1 then begin
            % can't make a magic square of the specified order               %
            false
            end
        else begin
            % order is OK - construct the square using de la Loubère's       %
            % algorithm as in the wikipedia page                             %

            % ensure a row/col position is on the square                     %
            integer procedure inSquare( integer value pos ) ;
                if pos < 1 then order else if pos > order then 1 else pos;
            % move "up" a row in the square                                  %
            integer procedure up   ( integer value row ) ; inSquare( row - 1 );
            % move "accross right" in the square                             %
            integer procedure right( integer value col ) ; inSquare( col + 1 );

            integer  row, col;
            % initialise square                                              %
            for i := 1 until order do for j := 1 until order do square( i, j ) := 0;

            % initial position is the middle of the top row                  %
            col := ( order + 1 ) div 2;
            row := 1;
            % construct square                                               %
            for i := 1 until ( order * order ) do begin
                square( row, col ) := i;
                if square( up( row ), right( col ) ) not = 0 then begin
                    % the up/right position is already taken, move down      %
                    row := row + 1;
                    end
                else begin
                    % can move up/right                                      %
                    row := up(    row );
                    col := right( col );
                end
            end for_i;
            % sucessful result                                               %
            true
        end magicSquare ;

    % prints the magic square                                                %
    procedure printSquare( integer array  square ( *, * )
                         ; integer value  order
                         ) ;
    begin
        integer sum, w;

        % set integer width to accomodate the largest number in the square   %
        w := ( order * order ) div 10;
        i_w := s_w := 1;
        while w > 0 do begin i_w := i_w + 1; w := w div 10 end;

        for i := 1 until order do sum := sum + square( 1, i );
        write( "maqic square of order ", order, ": sum: ", sum );
        for i := 1 until order do begin
            write( square( i, 1 ) );
            for j := 2 until order do writeon( square( i, j ) )
        end for_i

    end printSquare ;

    % test the magic square generation                                       %

    integer array sq ( 1 :: 11, 1 :: 11 );

    for i := 1, 3, 5, 7 do begin
        if magicSquare( sq, i ) then printSquare( sq, i )
                                else write( "can't generate square" );
    end for_i

end.


magic←{⍵{+/1,(1 ⍺⍺)×⍺(⍺⍺|1+⊢+2×⊣)⍵,⍺⍺-⍵+1}/¨⎕IO-⍨⍳⍵ ⍵}


---------------- MAGIC SQUARE OF ODD ORDER ---------------

-- oddMagicSquare :: Int -> [[Int]]
on oddMagicSquare(n)
    if 0 < (n mod 2) then
        cycleRows(transpose(cycleRows(table(n))))
    else
        missing value
    end if
end oddMagicSquare

--------------------------- TEST -------------------------
on run
    -- Orders 3, 5, 11

    -- wikiTableMagic :: Int -> String
    script wikiTableMagic
        on |λ|(n)
            formattedTable(oddMagicSquare(n))
        end |λ|
    end script

    intercalate(linefeed & linefeed, map(wikiTableMagic, {3, 5, 11}))
end run

-- table :: Int -> [[Int]]
on table(n)
    set lstTop to enumFromTo(1, n)

    script cols
        on |λ|(row)
            script rows
                on |λ|(x)
                    (row * n) + x
                end |λ|
            end script

            map(rows, lstTop)
        end |λ|
    end script

    map(cols, enumFromTo(0, n - 1))
end table

-- cycleRows :: [[a]] -> [[a]]
on cycleRows(lst)
    script rotationRow
        -- rotatedList :: [a] -> Int -> [a]
        on rotatedList(lst, n)
            if n = 0 then return lst

            set lng to length of lst
            set m to (n + lng) mod lng
            items -m thru -1 of lst & items 1 thru (lng - m) of lst
        end rotatedList

        on |λ|(row, i)
            rotatedList(row, (((length of row) + 1) div 2) - (i))
        end |λ|
    end script

    map(rotationRow, lst)
end cycleRows

-------------------- GENERIC FUNCTIONS -------------------

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m > n then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- splitOn :: Text -> Text -> [Text]
on splitOn(strDelim, strMain)
    set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
    set xs to text items of strMain
    set my text item delimiters to dlm
    return xs
end splitOn

-- transpose :: [[a]] -> [[a]]
on transpose(xss)
    script column
        on |λ|(_, iCol)
            script row
                on |λ|(xs)
                    item iCol of xs
                end |λ|
            end script

            map(row, xss)
        end |λ|
    end script

    map(column, item 1 of xss)
end transpose

----------------------- WIKI DISPLAY ---------------------

-- formattedTable :: [[Int]] -> String
on formattedTable(lstTable)
    set n to length of lstTable
    set w to 2.5 * n
    "magic(" & n & ")" & linefeed & linefeed & wikiTable(lstTable, ¬
        false, "text-align:center;width:" & ¬
        w & "em;height:" & w & "em;table-layout:fixed;")
end formattedTable

-- wikiTable :: [Text] -> Bool -> Text -> Text
on wikiTable(xs, blnHdr, strStyle)
    script wikiRows
        on |λ|(lstRow, iRow)
            set strDelim to cond(blnHdr and (iRow = 0), "!", "|")
            set strDbl to strDelim & strDelim
            linefeed & "|-" & linefeed & strDelim & space & ¬
                intercalate(space & strDbl & space, lstRow)
        end |λ|
    end script

    linefeed & "{| class=\"wikitable\" " & ¬
        cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
        intercalate("", ¬
            map(wikiRows, xs)) & linefeed & "|}" & linefeed
end wikiTable

-- cond :: Bool -> a -> a -> a
on cond(bool, f, g)
    if bool then
        f
    else
        g
    end if
end cond


oddMagicSquare: function [n][
    ensure -> and? odd? n
                   n >= 0

    map 1..n 'i [
        map 1..n 'j [
            (n * ((i + (j - 1) + n / 2) % n)) +
                      (((i - 2) + 2 * j) % n) + 1
        ]
    ]
]

loop [3 5 7] 'n [
    print ["Size:" n ", Magic sum:" n*(1+n*n)/2 "\n"]
    loop oddMagicSquare n 'row [
        loop row 'item [
            prints pad to :string item 3
        ]
        print ""
    ]
    print ""
]


msgbox % OddMagicSquare(5)
msgbox % OddMagicSquare(7)
return

OddMagicSquare(oddN){
	sq := oddN**2
	obj := {}
	loop % oddN
		obj[A_Index] := {} 	; dis is row
	mid := Round((oddN+1)/2)
	sum := Round(sq*(sq+1)/2/oddN)
	obj[1][mid] := 1
	cR := 1 , cC := mid
	loop % sq-1
	{
		done := 0 , a := A_index+1
		while !done {
			nR := cR-1 , nC := cC+1
			if !nR
				nR := oddN
			if (nC>oddN)
				nC := 1
			if obj[nR][nC] 	;filled
				cR += 1
			else cR := nR , cC := nC
			if !obj[cR][cC]
				obj[cR][cC] := a , done := 1
		}
	}

	str := "Magic Constant for " oddN "x" oddN " is " sum "`n"
	for k,v in obj
	{
		for k2,v2 in v
			str .= " " v2
		str .= "`n"
	}
	return str
}


# syntax: GAWK -f MAGIC_SQUARES_OF_ODD_ORDER.AWK
BEGIN {
    build(5)
    build(3,1) # verify sum
    build(7)
    exit(0)
}
function build(n,check,  arr,i,width,x,y) {
    if (n !~ /^[0-9]*[13579]$/ || n < 3) {
      printf("error: %s is invalid\n",n)
      return
    }
    printf("\nmagic constant for %dx%d is %d\n",n,n,(n*n+1)*n/2)
    x = 0
    y = int(n/2)
    for (i=1; i<=(n*n); i++) {
      arr[x,y] = i
      if (arr[(x+n-1)%n,(y+n+1)%n]) {
        x = (x+n+1) % n
      }
      else {
        x = (x+n-1) % n
        y = (y+n+1) % n
      }
    }
    width = length(n*n)
    for (x=0; x<n; x++) {
      for (y=0; y<n; y++) {
        printf("%*s ",width,arr[x,y])
      }
      printf("\n")
    }
    if (check) { verify(arr,n) }
}
function verify(arr,n,  total,x,y) { # verify sum of each row, column and diagonal
    print("\nverify")
# horizontal
    for (x=0; x<n; x++) {
      total = 0
      for (y=0; y<n; y++) {
        printf("%d ",arr[x,y])
        total += arr[x,y]
      }
      printf("\t: %d row %d\n",total,x+1)
    }
# vertical
    for (y=0; y<n; y++) {
      total = 0
      for (x=0; x<n; x++) {
        printf("%d ",arr[x,y])
        total += arr[x,y]
      }
      printf("\t: %d column %d\n",total,y+1)
    }
# left diagonal
    total = 0
    for (x=y=0; x<n; x++ y++) {
      printf("%d ",arr[x,y])
      total += arr[x,y]
    }
    printf("\t: %d diagonal top left to bottom right\n",total)
# right diagonal
    x = n - 1
    total = 0
    for (y=0; y<n; y++ x--) {
      printf("%d ",arr[x,y])
      total += arr[x,y]
    }
    printf("\t: %d diagonal bottom left to top right\n",total)
}


  100 :
  110  REM  MAGIC SQUARE OF ODD ORDER
  120 :
  130  DEF FN MOD(A) = A -  INT (A / N) * N
  140  DEF FN NR(J) =  FN MOD((J + 2 * I + 1))
  200  INPUT "ENTER N: ";N
  210  IF N < 3 OR (N - INT (N / 2) * 2) = 0 GOTO 200
  220  FOR I = 0 TO (N - 1)
  230  FOR J = 0 TO (N - 1): HTAB 4 * (J + 1)
  240  PRINT N * FN NR(N - J - 1) + FN NR(J) + 1;
  250  NEXT J: PRINT
  260  NEXT I
  270  PRINT "MAGIC CONSTANT: ";N * (N * N + 1) / 2


@echo off
rem Magic squares of odd order
setlocal EnableDelayedExpansion
set n=9
echo The square order is: %n%
for /l %%i in (1,1,%n%) do (
    set w=
    for /l %%j in (1,1,%n%) do (
        set /a v1=%%i*2-%%j+n-1
        set /a v1=v1%%n*n
        set /a v2=%%i*2+%%j+n-2
        set /a v2=v2%%n
        set /a v=v1+v2+1
		set v=     !v!
	    set w=!w!!v:~-5!)
	echo !w!)
set /a w=n*(n*n+1)/2
echo The magic number is: %w%
pause


define magic_constant(n) {
    return(((n * n + 1) / 2) * n)
}

define print_magic_square(n) {
    auto i, x, col, row, len, old_scale

    old_scale = scale
    scale = 0
    len = length(n * n)

    print "Magic constant for n=", n, ": ", magic_constant(n), "\n"
    for (row = 1; row <= n; row++) {
        for (col = 1; col <= n; col++) {
            x = n * ((row + col - 1 + (n / 2)) % n) + \
                ((row + 2 * col - 2) % n) + 1
            for (i = 0; i < len - length(x); i++) {
                print " "
            }
            print x
            if (col != n) print " "
        }
        print "\n"
    }

    scale = old_scale
}

temp = print_magic_square(5)


get "libhdr"

let cell(n, x, y) = f(n, n-x-1, y)*n + f(n, x, y) + 1
and f(n, x, y) = (x + y*2 + 1) rem n

let magic(n) be
$(  writef("Magic square of order %N with constant %N:*N", n, (n*n+1)/2*n)
    for y = 0 to n-1
    $(  for x = 0 to n-1 do writed(cell(n, x, y), 4)
        wrch('*N')
    $)
    wrch('*N')
$)

let start() be for n = 1 to 7 by 2 do magic(n)


Magic ← {𝕏{+´1∾1‿𝕗×𝕨(𝕗|1+⊢+2×⊣)𝕩∾𝕗-𝕩+1}´¨↕2⥊𝕩}
Magic¨ ⟨1,3,5,7⟩


#include <stdio.h>
#include <stdlib.h>

int f(int n, int x, int y)
{
	return (x + y*2 + 1)%n;
}

int main(int argc, char **argv)
{
	int i, j, n;

	//Edit: Add argument checking
	if(argc!=2) return 1;

	//Edit: Input must be odd and not less than 3.
	n = atoi(argv[1]);
	if (n < 3 || (n%2) == 0) return 2;

	for (i = 0; i < n; i++) {
		for (j = 0; j < n; j++)
			printf("% 4d", f(n, n - j - 1, i)*n + f(n, j, i) + 1);
		putchar('\n');
	}
	printf("\n Magic Constant: %d.\n", (n*n+1)/2*n);

	return 0;
}


#include <iostream>
#include <sstream>
#include <iomanip>
#include <cassert>
#include <vector>
using namespace std;

class MagicSquare
{
public:
    MagicSquare(int d) : sqr(d*d,0), sz(d)
    {
        assert(d&1);
        fillSqr();
    }

    void display()
    {
        cout << "Odd Magic Square: " << sz << " x " << sz << "\n";
        cout << "It's Magic Sum is: " << magicNumber() << "\n\n";
        ostringstream cvr;
        cvr << sz * sz;
        int l = cvr.str().size();

	for( int y = 0; y < sz; y++ )
	{
	    int yy = y * sz;
	    for( int x = 0; x < sz; x++ )
		cout << setw( l + 2 ) << sqr[yy + x];
	    cout << "\n";
	}
        cout << "\n\n";
    }

private:
    void fillSqr()
    {
	int sx = sz / 2, sy = 0, c = 0;
	while( c < sz * sz )
	{
	    if( !sqr[sx + sy * sz] )
	    {
		sqr[sx + sy * sz]= c + 1;
		inc( sx ); dec( sy );
		c++;
	    }
	    else
	    {
		dec( sx ); inc( sy ); inc( sy );
	    }
	}
    }

    int magicNumber()
    { return sz * ( ( sz * sz ) + 1 ) / 2; }

    void inc( int& a )
    { if( ++a == sz ) a = 0; }

    void dec( int& a )
    { if( --a < 0 ) a = sz - 1; }

    bool checkPos( int x, int y )
    { return( isInside( x ) && isInside( y ) && !sqr[sz * y + x] ); }

    bool isInside( int s )
    { return ( s < sz && s > -1 ); }

    vector<int> sqr;
    int sz;
};

int main()
{
    MagicSquare s(7);
    s.display();
    return 0;
}


magic_square = cluster is create, unparse, magic_number
    rep = array[array[int]]

    create = proc (order: int) returns (cvt) signals (invalid)
        if order<1 cor order//2 = 0 then signal invalid end
        sq: rep := rep$fill_copy(1, order, array[int]$fill(1, order, 0))
        x: int := (order+1)/2
        y: int := 1

        for i: int in int$from_to(1, order**2) do
            sq[y][x] := i
            next_x: int := inc(sq,x)
            next_y: int := dec(sq,y)
            if sq[next_y][next_x]=0
                then x, y := next_x, next_y
                else y := inc(sq,y)
            end
        end
        return(sq)
    end create

    inc = proc (sq: rep, co: int) returns (int)
        order: int := rep$size(sq)
        if co=order then return(1) else return(co+1) end
    end inc

    dec = proc (sq: rep, co: int) returns (int)
        order: int := rep$size(sq)
        if co=1 then return(order) else return(co-1) end
    end dec

    unparse = proc (sq: cvt) returns (string)
        order: int := rep$size(sq)
        col_size: int := string$size(int$unparse(order ** 2)) + 1
        ss: stream := stream$create_output()
        for y: int in int$from_to(1, order) do
            for x: int in int$from_to(1, order) do
                stream$putright(ss, int$unparse(sq[y][x]), col_size)
            end
            stream$putl(ss, "")
        end
        return(stream$get_contents(ss))
    end unparse

    magic_number = proc (sq: cvt) returns (int)
        order: int := rep$size(sq)
        n: int := 0
        for x: int in int$from_to(1, order) do n := n + sq[1][x] end
        return(n)
    end magic_number
end magic_square

print_magic_square = proc (order: int)
    po: stream := stream$primary_output()
    ms: magic_square := magic_square$create(order)
    stream$putl(po, "Magic square of order "
                 || int$unparse(order)
                 || " with magic number "
                 || int$unparse(magic_square$magic_number(ms))
                 || ": ")
    stream$putl(po, magic_square$unparse(ms))
end print_magic_square

start_up = proc ()
    for n: int in int$from_to_by(1, 7, 2) do
        print_magic_square(n)
    end
end start_up


(defun magic-square (n)
  (loop for i from 1 to n
        collect
          (loop for j from 1 to n
                collect
                  (+ (* n (mod (+ i j (floor n 2) -1)
                               n))
                     (mod (+ i (* 2 j) -2)
                          n)
                     1))))

(defun magic-constant (n)
  (* n
     (/ (1+ (* n n))
        2)))

(defun output (n)
  (format T "Magic constant for n=~a: ~a~%" n (magic-constant n))
  (let* ((size (length (write-to-string (* n n))))
         (format-str (format NIL "~~{~~{~~~ad~~^ ~~}~~%~~}~~%" size)))
    (format T format-str (magic-square n))))


include "cowgol.coh";

sub magic(n: uint16) is
    sub f(x: uint16, y: uint16): (r: uint16) is
        r := (x + y*2 + 1) % n;
    end sub;

    sub cell(x: uint16, y: uint16): (c: uint16) is
        c := f(n-x-1, y)*n + f(x, y) + 1;
    end sub;

    var y: uint16 := 0;
    while y < n loop
        var x: uint16 := 0;
        loop
            print_i16(cell(x, y));
            x := x + 1;
            if x == n then
                print_nl();
                break;
            else
                print_char('\t');
            end if;
        end loop;
        y := y + 1;
    end loop;
    print_nl();
end sub;

var n: uint16 := 1;
while n <= 7 loop
    print("Magic square of order ");
    print_i16(n);
    print(" with constant ");
    print_i16((n*n+1)/2*n);
    print(":\n");
    magic(n);
    n := n + 2;
end loop;


void main(in string[] args)
{
    import std.stdio, std.conv, std.range, std.algorithm, std.exception;

    immutable n = args.length == 2 ? args[1].to!uint : 5;
    enforce(n > 0 && n % 2 == 1, "Only odd n > 1");
    immutable len = text(n ^^ 2).length.text;
   // writeln(len);

    foreach (immutable r; 1 .. n + 1)
    {
        foreach (immutable c; 1 .. n + 1)
        {
            auto a = (n * ((r + c - 1 + (n / 2)) % n)) + ((r + (2 * c) - 2) % n) + 1;
            // n(( I + J - 1 + ( n / 2 ) ) mod n ) + (( I + 2J - 2 ) mod n ) + 1
//        writeln("n = ",n, " r = ",r," c = ",c, " a = ",a );
          writef("%" ~ len ~ "d%s",a, " ");
        }
        writeln("");
    }
    ;

    writeln("\nMagic constant: ", ((n * n + 1) * n) / 2);
}}


proc inc(word n, order) word: if n=order-1 then 0 else n+1 fi corp
proc dec(word n, order) word: if n=0 then order-1 else n-1 fi corp

proc odd_magic_square([*,*]word square) void:
    word order, x, nx, y, ny, i;
    order := dim(square,1);

    for x from 0 upto order-1 do
        for y from 0 upto order-1 do
            square[x,y] := 0
        od
    od;

    x := order/2;
    y := 0;
    for i from 1 upto order*order do
        square[x,y] := i;
        nx := inc(x,order);
        ny := dec(y,order);
        if square[nx,ny] = 0 then
            x := nx;
            y := ny
        else
            y := inc(y,order)
        fi
    od
corp

proc digit_count(word n) word:
    word count;
    count := 0;
    while n > 0 do
        count := count + 1;
        n := n / 10
    od;
    count
corp

proc print_magic_square([*,*]word square) void:
    word order, max, col_size, magic, x, y;
    order := dim(square,1);
    max := order*order;
    col_size := digit_count(max) + 1;

    magic := 0;
    for x from 0 upto order-1 do magic := magic + square[x,0] od;

    writeln("Magic square of order ",order," with magic number ",magic,":");
    for y from 0 upto order-1 do
        for x from 0 upto order-1 do write(square[x,y]:col_size) od;
        writeln()
    od;
    writeln()
corp

proc main() void:
    [1,1]word sq1;
    [3,3]word sq3;
    [5,5]word sq5;
    [7,7]word sq7;

    odd_magic_square(sq1);
    odd_magic_square(sq3);
    odd_magic_square(sq5);
    odd_magic_square(sq7);

    print_magic_square(sq1);
    print_magic_square(sq3);
    print_magic_square(sq5);
    print_magic_square(sq7)
corp


(lib 'matrix)

;; compute next i,j = f(move,i,j)
(define-syntax-rule (path imove jmove)
(begin (set! i (imove i n)) (set! j (jmove j n))))

;; We define the ordinary and break moves
;; (1 , -1), (0, 1) King's move
(define (inext i n) (modulo (1+ i) n))
(define (jnext j n) (modulo (1- j) n))
(define (ibreak i n) i)
(define (jbreak j n) (modulo (1+ j) n))

(define (make-ms n)
    (define n2+1 (1+ (* n n)))
    (define ms (make-array n n))
    (define i (quotient n 2))
    (define j 0)
    (array-set! ms i j 1)

    (for ((ns (in-range 2  n2+1)))
        (if (zero? (array-ref ms (inext i n ) (jnext j n )))
            (path inext jnext) ;; ordinary move if empty target
            (path ibreak jbreak)) ;; else break move

        (if (zero? (array-ref ms i j))
            (array-set! ms i j ns)
            (error ns "illegal path"))
    )
    (writeln 'order n 'magic-number  (/ ( * n n2+1) 2))
    (array-print ms))


defmodule RC do
  def odd_magic_square(n) when rem(n,2)==1 do
    for i <- 0..n-1 do
      for j <- 0..n-1, do: n * rem(i+j+1+div(n,2),n) + rem(i+2*j+2*n-5,n) + 1
    end
  end

  def print_square(sq) do
    width = List.flatten(sq) |> Enum.max |> to_char_list |> length
    fmt = String.duplicate(" ~#{width}w", length(sq)) <> "~n"
    Enum.each(sq, fn row -> :io.format fmt, row end)
  end
end

Enum.each([3,5,11], fn n ->
  IO.puts "\nSize #{n}, magic sum #{div(n*n+1,2)*n}"
  RC.odd_magic_square(n) |> RC.print_square
end)