add sha384 and sha512 to lib/crypto.arc

add sha384 and sha512 to lib/crypto.arc

($ (require file/md5))
(load "lib/lang.arc")

(def md5 (str)
  (($ bytes->string/utf-8) (($ md5) (($ string->bytes/utf-8) str))))

(def sha224 (data)
  (perl subprocess “
	use Digest::SHA qw(sha224_hex);
	sha224_hex(«data»);
	”))

(def sha384 (data)
  (perl subprocess “
	use Digest::SHA qw(sha384_hex);
	sha384_hex(«data»);
	”))

(def sha512 (data)
  (perl subprocess “
	use Digest::SHA qw(sha512_hex);
	sha512_hex(«data»);
	”))

(def whirlpool (data)
  (perl subprocess “
        use Digest;

        my $whirlpool = Digest->new( 'Whirlpool' );

	$whirlpool->add(«data»);
        $whirlpool->hexdigest;
	”))

; TODO need a more sane return value than a string
;(def aes-encrypt (key plaintext)
;  (perl subprocess “
;	use Crypt::OpenSSL::AES;
;
;	my $cipher = new Crypt::OpenSSL::AES(«key»);
;
;	$cipher->encrypt(«plaintext»);
;	”))
;
;(def aes-decrypt (key ciphertext)
;  (perl subprocess “
;	use Crypt::OpenSSL::AES;
;
;	my $cipher = new Crypt::OpenSSL::AES(«key»);
;
;	$cipher->decrypt(«ciphertext»);
;	”))

($ (require file/md5))
(load "lib/lang.arc")

(def md5 (str)
  (($ bytes->string/utf-8) (($ md5) (($ string->bytes/utf-8) str))))

(def sha224 (data)
  (perl subprocess “
	use Digest::SHA qw(sha224_hex);
	sha224_hex(«data»);
	”))

(def whirlpool (data)
  (perl subprocess “
        use Digest;

        my $whirlpool = Digest->new( 'Whirlpool' );

	$whirlpool->add(«data»);
        $whirlpool->hexdigest;
	”))

; TODO need a more sane return value than a string
;(def aes-encrypt (key plaintext)
;  (perl subprocess “
;	use Crypt::OpenSSL::AES;
;
;	my $cipher = new Crypt::OpenSSL::AES(«key»);
;
;	$cipher->encrypt(«plaintext»);
;	”))
;
;(def aes-decrypt (key ciphertext)
;  (perl subprocess “
;	use Crypt::OpenSSL::AES;
;
;	my $cipher = new Crypt::OpenSSL::AES(«key»);
;
;	$cipher->decrypt(«ciphertext»);
;	”))


Tweak REPL to remember the last expression entered

; Prompt: Web-based programming application.  4 Aug 06.

(= appdir* "arc/apps/")

(defop prompt req
  (let user (get-user req)
    (if (admin user)
        (prompt-page user)
        (pr "Sorry."))))

(def prompt-page (user . msg)
  (ensure-dir appdir*)
  (ensure-dir (string appdir* user))
  (whitepage
    (prbold "Prompt")
    (hspace 20)
    (pr user " | ")
    (link "logout")
    (when msg (hspace 10) (apply pr msg))
    (br2)
    (tag (table border 0 cellspacing 10)
      (each app (dir (+ appdir* user))
        (tr (td app)
            (td (ulink user 'edit   (edit-app user app)))
            (td (ulink user 'run    (run-app  user app)))
            (td (hspace 40)
                (ulink user 'delete (rem-app  user app))))))
    (br2)
    (aform (fn (req)
             (when-umatch user req
               (aif (goodname (arg req "app"))
                    (edit-app user it)
                    (prompt-page user "Bad name."))))
       (tab (row "name:" (input "app") (submit "create app"))))))

(def app-path (user app)
  (and user app (+ appdir* user "/" app)))

(def read-app (user app)
  (aand (app-path user app)
        (file-exists it)
        (readfile it)))

(def write-app (user app exprs)
  (awhen (app-path user app)
    (w/outfile o it
      (each e exprs (write e o)))))

(def rem-app (user app)
  (let file (app-path user app)
    (if (file-exists file)
        (do (rmfile (app-path user app))
            (prompt-page user "Program " app " deleted."))
        (prompt-page user "No such app."))))

(def edit-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (aform (fn (req)
             (let u2 (get-user req)
               (if (is u2 user)
                   (do (when (is (arg req "cmd") "save")
                         (write-app user app (readall (arg req "exprs"))))
                       (prompt-page user))
                   (login-page 'both nil
                               (fn (u ip) (prompt-page u))))))
      (textarea "exprs" 10 82
        (pprcode (read-app user app)))
      (br2)
      (buts 'cmd "save" "cancel"))))

(def pprcode (exprs)
  (each e exprs
    (ppr e)
    (pr "\n\n")))

(def view-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (tag xmp (pprcode (read-app user app)))))

(def run-app (user app)
  (let exprs (read-app user app)
    (if exprs
        (on-err (fn (c) (pr "Error: " (details c)))
          (fn () (map eval exprs)))
        (prompt-page user "Error: No application " app " for user " user))))

(^ repl-history* nil)

(defop repl req
  (if (admin (get-user req))
      (replpage req)
      (pr "Sorry.")))

(def replpage (req)
  (whitepage
    (repl (readall (or (arg req "expr") "")) "repl")))

(def repl (exprs url)
    (each expr exprs
      (on-err (fn (c) (push (list expr c t) repl-history*))
              (fn ()
                (= that (eval expr) thatexpr expr)
                (push (list expr that) repl-history*))))
    (form url
      (textarea "expr" 8 60
        (write (car repl-history*)))
      (sp)
      (submit))
    (tag xmp
      (each (expr val err) (firstn 20 repl-history*)
        (pr "> ")
        (ppr expr)
        (prn)
        (prn (if err "Error: " "")
             (ellipsize (tostring (write val)) 800)))))

; Prompt: Web-based programming application.  4 Aug 06.

(= appdir* "arc/apps/")

(defop prompt req
  (let user (get-user req)
    (if (admin user)
        (prompt-page user)
        (pr "Sorry."))))

(def prompt-page (user . msg)
  (ensure-dir appdir*)
  (ensure-dir (string appdir* user))
  (whitepage
    (prbold "Prompt")
    (hspace 20)
    (pr user " | ")
    (link "logout")
    (when msg (hspace 10) (apply pr msg))
    (br2)
    (tag (table border 0 cellspacing 10)
      (each app (dir (+ appdir* user))
        (tr (td app)
            (td (ulink user 'edit   (edit-app user app)))
            (td (ulink user 'run    (run-app  user app)))
            (td (hspace 40)
                (ulink user 'delete (rem-app  user app))))))
    (br2)
    (aform (fn (req)
             (when-umatch user req
               (aif (goodname (arg req "app"))
                    (edit-app user it)
                    (prompt-page user "Bad name."))))
       (tab (row "name:" (input "app") (submit "create app"))))))

(def app-path (user app)
  (and user app (+ appdir* user "/" app)))

(def read-app (user app)
  (aand (app-path user app)
        (file-exists it)
        (readfile it)))

(def write-app (user app exprs)
  (awhen (app-path user app)
    (w/outfile o it
      (each e exprs (write e o)))))

(def rem-app (user app)
  (let file (app-path user app)
    (if (file-exists file)
        (do (rmfile (app-path user app))
            (prompt-page user "Program " app " deleted."))
        (prompt-page user "No such app."))))

(def edit-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (aform (fn (req)
             (let u2 (get-user req)
               (if (is u2 user)
                   (do (when (is (arg req "cmd") "save")
                         (write-app user app (readall (arg req "exprs"))))
                       (prompt-page user))
                   (login-page 'both nil
                               (fn (u ip) (prompt-page u))))))
      (textarea "exprs" 10 82
        (pprcode (read-app user app)))
      (br2)
      (buts 'cmd "save" "cancel"))))

(def pprcode (exprs)
  (each e exprs
    (ppr e)
    (pr "\n\n")))

(def view-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (tag xmp (pprcode (read-app user app)))))

(def run-app (user app)
  (let exprs (read-app user app)
    (if exprs
        (on-err (fn (c) (pr "Error: " (details c)))
          (fn () (map eval exprs)))
        (prompt-page user "Error: No application " app " for user " user))))

(^ repl-history* nil)

(defop repl req
  (if (admin (get-user req))
      (replpage req)
      (pr "Sorry.")))

(def replpage (req)
  (whitepage
    (repl (readall (or (arg req "expr") "")) "repl")))

(def repl (exprs url)
    (each expr exprs
      (on-err (fn (c) (push (list expr c t) repl-history*))
              (fn ()
                (= that (eval expr) thatexpr expr)
                (push (list expr that) repl-history*))))
    (form url
      (textarea "expr" 8 60)
      (sp)
      (submit))
    (tag xmp
      (each (expr val err) (firstn 20 repl-history*)
        (pr "> ")
        (ppr expr)
        (prn)
        (prn (if err "Error: " "")
             (ellipsize (tostring (write val)) 800)))))


back to templates as of Feb 23

back to templates as of Feb 23

(= templates* (table))

(mac deftem (tem . fields)
  (withs (name (carif tem) includes (if (acons tem) (cdr tem)))
    `(= (templates* ',name)
        (+ (mappend templates* ',(rev includes))
           (list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
                        (pair fields)))))))

(mac addtem (name . fields)
  `(= (templates* ',name)
      (union (fn (x y) (is (car x) (car y)))
             (list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
                          (pair fields)))
             (templates* ',name))))

; (tagged 'tem (tem-type fields nils))
(def inst (tem-type . args)
  (annotate 'tem (list tem-type
                       (coerce pair.args 'table)
                       (memtable (map car (keep no:cadr pair.args))))))

(extend sref (tem v k) (isa tem 'tem)
  (sref rep.tem.1 v k)
  (if v
    (wipe rep.tem.2.k)
    (set rep.tem.2.k)))

(defcall tem (tem k)
  (or rep.tem.1.k
      (if (no rep.tem.2.k)
        ((alref (templates* rep.tem.0) k)))))

(defmethod iso(a b) tem
  (and (isa a 'tem)
       (isa b 'tem)
       (iso rep.a rep.b)))

(def temload (tem file)
  (w/infile i file (temread tem i)))

(def temloadall (tem file)
  (w/infile i file (drain:temread tem i)))

(def temstore (tem val file)
  (writefile (temlist tem val) file))

(def temread (tem (o str (stdin)))
  (reading fields str
    (listtem tem fields)))

(def temwrite (tem val (o o (stdout)))
  (write (temlist tem val) o))

; coerce alist to a specific template
(def listtem (tem fields)
  (apply inst tem (apply + fields)))

; like tablist, but include explicitly-set nil fields
(def temlist (tem val)
  (ret fields (coerce rep.val.1 'cons)
    (iflet nil-fields (coerce rep.val.2 'cons)
      (each (k v) (if acons.tem
                    tem
                    templates*.tem)
        (if (assoc k nil-fields)
          (push (list k nil) fields))))))

(= templates* (table))

(mac deftem (tem . fields)
  (withs (name (carif tem) includes (if (acons tem) (cdr tem)))
    `(= (templates* ',name)
        (+ (mappend templates* ',(rev includes))
           (list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
                        (pair fields)))))))

(mac addtem (name . fields)
  `(= (templates* ',name)
      (union (fn (x y) (is (car x) (car y)))
             (list ,@(map (fn ((k v)) `(list ',k (fn () ,v)))
                          (pair fields)))
             (templates* ',name))))

; (tagged 'tem (tem-type fields nils))
(def inst (tem-type . args)
  (annotate 'tem (list tem-type
                       (w/table x
                         (each (k v) (if acons.tem-type tem-type templates*.tem-type)
                           (unless no.v
                             (= x.k (v))))
                         (each (k v) pair.args
                           (= x.k v))))))

(extend sref (tem v k) (isa tem 'tem)
  (sref rep.tem.1 v k))

(defcall tem (tem k)
  rep.tem.1.k)

(defmethod iso(a b) tem
  (and (isa a 'tem)
       (isa b 'tem)
       (iso rep.a rep.b)))

(def temload (tem file)
  (w/infile i file (temread tem i)))

(def temloadall (tem file)
  (w/infile i file (drain:temread tem i)))

(def temstore (tem val file)
  (writefile (temlist tem val) file))

(def temread (tem (o str (stdin)))
  (reading fields str
    (listtem tem fields)))

(def temwrite (tem val (o o (stdout)))
  (write (temlist tem val) o))

; coerce alist to a specific template
(def listtem (tem fields)
  (apply inst tem (if fields
                    (apply + fields))))

; like tablist, but include explicitly-set nil fields
(def temlist (tem val)
  (coerce rep.val.1 'cons))


trailing whitespace

trailing whitespace

; written by Mark Huetsch and Brian J Rubinton
; same license as Arc
;
; Primary interface:
;   1)  mkreq - Build request, send request, receive response as (list header body).
;   2) defreq - Create named function wrappers for mkreq.
;             - Intended for multi-use http requests.
;             - Url query parameters can be passed into wrapper for each request.
;             - example: see (defreq google '(q "bagels new york city"))
;   3)  mkuri - Construct a uri from url and query list.
;             - Only compatible with GET requests.

(require "lib/re.arc")

(= protocol* "HTTP/1.0"
   useragent* "Web.arc/1.0"
   content-type* "Content-Type: application/x-www-form-urlencoded")

(mac w/io (io request func)
  (w/uniq (i o response)
    `(let (,i ,o) ,io
      (disp ,request ,o)
      (let ,response (,func ,i)
        (close ,i ,o)
        ,response))))

(def mkreq (url (o querylist) (o method "GET") (o cookies))
  (let url (parse-url url)
    (w/io (get-io   url!resource url!host url!port)
          (buildreq url!host
                    url!path
                    (build-query url!query querylist)
                    (upcase method)
                    cookies)
          receive-response)))

(mac defreq (name url (o querylist) (o method "GET") (o cookies))
  `(def ,name ((o param))
    (mkreq ,url (join ,querylist param) ,method ,cookies)))

(def mkuri (url (o querylist))
  (let url (parse-url url)
    (+ url!resource "://"
       url!host ":"
       url!port
       (build-uri url!path "GET" (build-query url!query querylist)))))

(def parse-url (url)
  (withs ((resource url) (split-at "://" (ensure-resource (strip-after "#" url)))
          (hp pq)        (split-at "/" url)
          (host port)    (split-at ":" hp)
          (path query)   (split-at "?" pq))
    (obj resource resource
         host     host
         port     (select-port port resource)
         path     path
         query    query)))

(def ensure-resource (url)
  (if (posmatch "://" url) url (+ "http://" url)))

(def strip-after (delim s)
  (car (split-at delim s)))

(def split-at (delim s)
  " Split string s at first instance of delimeter.
    Return split list. "
  (iflet i (posmatch delim s)
    (list (cut s 0 i) (cut s (+ i (len delim))))
    (list s)))

(def select-port (portstr resource)
  (if (nonblank portstr)
    (int portstr)
    (default-port resource)))

(def default-port (resource)
  (if (is resource "https") 443 80))

(def build-query (querystr querylist)
  (string querystr
          (and (nonblank querystr)
               querylist
               '&)
          (to-query-str querylist)))

(def to-query-str (querylist)
  (if querylist
    (joinstr (map [joinstr _ "="] (pair (map [coerce _ 'string] querylist)))
             "&")))

(def build-header (host path query method cookies)
  (reduce +
    (intersperse (str-rn)
                 (flat:list
                   (first-req-line method path query)
                   (request-header host)
                   (entity-header  method query)
                   (cookie-header  cookies)))))

(def first-req-line (method path query)
  (+ method " " (build-uri path method query) " " protocol*))

(def build-uri (path method (o query ""))
  (+ "/" path (and (is method "GET")
                   (nonblank query)
                   (+ "?" query))))

(def request-header (host)
  (list (+ "Host: " host) useragent*))

(def entity-header (method query)
  (if (is method "POST")
    (list (+ "Content-Length: " (len (utf-8-bytes query))) content-type*)))

(def cookie-header (cookies)
  (if cookies (encode-cookies cookies)))

(def encode-cookies (cookielist)
  (let joined-list (map [joinstr _ #\=] (pair cookielist))
    (+ "Cookie: "
       (if (len> joined-list 1)
         (reduce [+ _1 "; " _2] joined-list)
         (car joined-list))
       ";")))

(def build-body (query method)
  (if (and (is method "POST") (nonblank query))
    (+ query (str-rn))
    nil))

(def buildreq (host path query method cookies)
  (+ (build-header host path query method cookies)
     (str-rn 2)
     (build-body query method)))

(def str-rn ((o n 1))
  (if (<= n 1)
    (string #\return #\newline)
    (string (str-rn) (str-rn (- n 1)))))

(def get-io (resource host port)
  (if (is resource "https")
    (ssl-connect host port)
    (socket-connect host port)))

(def receive-response ((o s (stdin)))
  (list (read-header s) (read-body s)))

(def read-header ((o s (stdin)))
  " Read each line from port until a blank line is reached. "
  (accum a
    (whiler line (readline s) blank
      (a line))))

(def read-body ((o s (stdin)))
  " Read remaining lines from port. "
  (tostring
    (whilet line (readline s)
      (pr line))))

; Convenience functions.
; Note: these ignore the response header: (car (mkreq url))
(def get-url (url)
  (cdr (mkreq url)))

(def post-url (url args)
  (cdr (mkreq url args "POST")))

; TODO write functions to parse/tokenize header lines
; TODO refactor google func to use defreq macro
(def google (q)
  (get-url (+ "www.google.com/search?q=" (urlencode q))))


locore.S and we have no SFILES at the moment

#	$OpenBSD: Makefile.arc,v 1.14 2000/08/15 01:03:36 imp Exp $

#	@(#)Makefile.arc	8.2 (Berkeley) 2/16/94
#
# Makefile for 4.4 BSD
#
# This makefile is constructed from a machine description:
#	config ``machineid''
# Most changes should be made in the machine description
#	/sys/arch/arc/conf/``machineid''
# after which you should do
#	 config ``machineid''
# Machine generic makefile changes should be made in
#	/sys/arch/arc/conf/Makefile.``machinetype''
# after which config should be rerun for all machines of that type.
#
# N.B.: NO DEPENDENCIES ON FOLLOWING FLAGS ARE VISIBLE TO MAKEFILE
#	IF YOU CHANGE THE DEFINITION OF ANY OF THESE RECOMPILE EVERYTHING
#
# -DTRACE	compile in kernel tracing hooks
# -DQUOTA	compile in file system quotas

# DEBUG is set to -g by config if debugging is requested (config -g).
# PROF is set to -pg by config if profiling is requested (config -p).

AS?=	as
CC?=	cc
CPP?=	cpp
LD?=	ld
STRIP?=	strip -d
TOUCH?=	touch -f -c

# source tree is located via $S relative to the compilation directory
S=	../../../..
ARC=	../..
MIPS=	../../../mips

INCLUDES=	-I. -I$S/arch -I$S
CPPFLAGS=	${INCLUDES} ${IDENT} -D_KERNEL -Darc
CDIAGFLAGS=	-Werror -Wall -Wmissing-prototypes -Wstrict-prototypes \
		-Wno-uninitialized -Wno-format -Wno-main

CFLAGS=		${DEBUG} -O2 ${CDIAGFLAGS} -mno-abicalls -mips2 -mcpu=r4000 \
		${COPTS}
AFLAGS=		-x assembler-with-cpp -traditional-cpp -D_LOCORE

### find out what to use for libkern
.include "$S/lib/libkern/Makefile.inc"
.ifndef PROF
LIBKERN=	${KERNLIB}
.else
LIBKERN=	${KERNLIB_PROF}
.endif

### find out what to use for libcompat
.include "$S/compat/common/Makefile.inc"
.ifndef PROF
LIBCOMPAT=	${COMPATLIB}
.else
LIBCOMPAT=	${COMPATLIB_PROF}
.endif

# compile rules: rules are named ${TYPE}_${SUFFIX}${CONFIG_DEP}
# where TYPE is NORMAL, DRIVER, or PROFILE}; SUFFIX is the file suffix,
# capitalized (e.g. C for a .c file), and CONFIG_DEP is _C if the file
# is marked as config-dependent.

USRLAND_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
USRLAND_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

NORMAL_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
NORMAL_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

DRIVER_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
DRIVER_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

NORMAL_S=	${CC} ${AFLAGS} ${CPPFLAGS} -c $<
NORMAL_S_C=	${AS}  ${COPTS} ${PARAM} $< -o $@

%OBJS

%CFILES

%SFILES

# load lines for config "xxx" will be emitted as:
# xxx: ${SYSTEM_DEP} swapxxx.o
#	${SYSTEM_LD_HEAD}
#	${SYSTEM_LD} swapxxx.o
#	${SYSTEM_LD_TAIL}

SYSTEM_OBJ=	locore.o fp.o ${OBJS} param.o ioconf.o ${LIBKERN} \
		${LIBCOMPAT}
#
SYSTEM_DEP=	Makefile ${SYSTEM_OBJ}
SYSTEM_LD_HEAD=	rm -f $@
SYSTEM_LD=	-@if [ X${DEBUG} = X-g ]; \
		then strip=-X; \
		else strip=-x; \
		fi; \
		echo ${LD} $$strip -o $@ -e start -T ../../conf/ld.script \
			'$${SYSTEM_OBJ}' vers.o; \
		${LD} $$strip -o $@ -e start -T ../../conf/ld.script \
			${SYSTEM_OBJ} vers.o
#
SYSTEM_LD_TAIL=	chmod 755 $@; \
		elf2ecoff $@ $@.ecoff; \
		size $@

%LOAD

newvers:
	sh $S/conf/newvers.sh
	${CC} $(CFLAGS) -c vers.c

clean::
	rm -f eddep bsd bsd.gdb bsd.ecoff tags *.o locore.i [a-z]*.s \
	    Errs errs linterrs makelinks

lint: /tmp param.c
	@lint -hbxn -DGENERIC -Dvolatile= ${COPTS} ${PARAM} -UKGDB \
	    ${CFILES} ioconf.c param.c

symbols.sort: ${ARC}/arc/symbols.raw
	grep -v '^#' ${ARC}/arc/symbols.raw \
	    | sed 's/^	//' | sort -u > symbols.sort

locore.o: ${ARC}/arc/locore.S ${MIPS}/include/asm.h \
	${MIPS}/include/cpu.h ${MIPS}/include/reg.h assym.h
	${NORMAL_S} -mips3 ${ARC}/arc/locore.S

fp.o: ${MIPS}/mips/fp.S ${MIPS}/include/asm.h \
	${ARC}/include/cpu.h ${MIPS}/include/reg.h assym.h
	${NORMAL_S} -mips3 ${MIPS}/mips/fp.S

# the following are necessary because the files depend on the types of
# cpu's included in the system configuration
clock.o machdep.o autoconf.o conf.o: Makefile

# depend on network configuration
uipc_domain.o uipc_proto.o vfs_conf.o: Makefile
if_tun.o if_loop.o if_ethersubr.o: Makefile
in_proto.o: Makefile

assym.h: $S/kern/genassym.sh ${ARC}/arc/genassym.cf
	sh $S/kern/genassym.sh ${CC} ${CFLAGS} ${CPPFLAGS} \
	    ${PARAM} < ${ARC}/arc/genassym.cf > assym.h.tmp && \
	    mv -f assym.h.tmp assym.h

links:
	egrep '#if' ${CFILES} | sed -f $S/conf/defines | \
	  sed -e 's/:.*//' -e 's/\.c/.o/' | sort -u > dontlink
	echo ${CFILES} | tr -s ' ' '\12' | sed 's/\.c/.o/' | \
	  sort -u | comm -23 - dontlink | \
	  sed 's,../.*/\(.*.o\),rm -f \1;ln -s ../GENERIC/\1 \1,' > makelinks
	sh makelinks && rm -f dontlink

tags:
	@echo "see $S/kern/Makefile for tags"

ioconf.o: ioconf.c
	${NORMAL_C}

param.c: $S/conf/param.c
	rm -f param.c
	cp $S/conf/param.c .

param.o: param.c Makefile
	${NORMAL_C_C}

newvers: ${SYSTEM_DEP} ${SYSTEM_SWAP_DEP}
	sh $S/conf/newvers.sh
	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c vers.c

depend:: .depend
.depend: ${SRCS} assym.h param.c
	mkdep ${AFLAGS} ${CPPFLAGS} ${ARC}/arc/locore.S
	mkdep -a ${CFLAGS} ${CPPFLAGS} param.c ioconf.c ${CFILES}
#	mkdep -a ${AFLAGS} ${CPPFLAGS} ${SFILES}

%RULES

#	$OpenBSD: Makefile.arc,v 1.13 1999/08/15 20:43:57 niklas Exp $

#	@(#)Makefile.arc	8.2 (Berkeley) 2/16/94
#
# Makefile for 4.4 BSD
#
# This makefile is constructed from a machine description:
#	config ``machineid''
# Most changes should be made in the machine description
#	/sys/arch/arc/conf/``machineid''
# after which you should do
#	 config ``machineid''
# Machine generic makefile changes should be made in
#	/sys/arch/arc/conf/Makefile.``machinetype''
# after which config should be rerun for all machines of that type.
#
# N.B.: NO DEPENDENCIES ON FOLLOWING FLAGS ARE VISIBLE TO MAKEFILE
#	IF YOU CHANGE THE DEFINITION OF ANY OF THESE RECOMPILE EVERYTHING
#
# -DTRACE	compile in kernel tracing hooks
# -DQUOTA	compile in file system quotas

# DEBUG is set to -g by config if debugging is requested (config -g).
# PROF is set to -pg by config if profiling is requested (config -p).

AS?=	as
CC?=	cc
CPP?=	cpp
LD?=	ld
STRIP?=	strip -d
TOUCH?=	touch -f -c

# source tree is located via $S relative to the compilation directory
S=	../../../..
ARC=	../..
MIPS=	../../../mips

INCLUDES=	-I. -I$S/arch -I$S
CPPFLAGS=	${INCLUDES} ${IDENT} -D_KERNEL -Darc
CDIAGFLAGS=	-Werror -Wall -Wmissing-prototypes -Wstrict-prototypes \
		-Wno-uninitialized -Wno-format -Wno-main

CFLAGS=		${DEBUG} -O2 ${CDIAGFLAGS} -mno-abicalls -mips2 -mcpu=r4000 \
		${COPTS}
AFLAGS=		-x assembler-with-cpp -traditional-cpp -D_LOCORE

### find out what to use for libkern
.include "$S/lib/libkern/Makefile.inc"
.ifndef PROF
LIBKERN=	${KERNLIB}
.else
LIBKERN=	${KERNLIB_PROF}
.endif

### find out what to use for libcompat
.include "$S/compat/common/Makefile.inc"
.ifndef PROF
LIBCOMPAT=	${COMPATLIB}
.else
LIBCOMPAT=	${COMPATLIB_PROF}
.endif

# compile rules: rules are named ${TYPE}_${SUFFIX}${CONFIG_DEP}
# where TYPE is NORMAL, DRIVER, or PROFILE}; SUFFIX is the file suffix,
# capitalized (e.g. C for a .c file), and CONFIG_DEP is _C if the file
# is marked as config-dependent.

USRLAND_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
USRLAND_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

NORMAL_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
NORMAL_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

DRIVER_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c $<
DRIVER_C_C=	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} ${PARAM} -c $<

NORMAL_S=	${CC} ${AFLAGS} ${CPPFLAGS} -c $<
NORMAL_S_C=	${AS}  ${COPTS} ${PARAM} $< -o $@

%OBJS

%CFILES

%SFILES

# load lines for config "xxx" will be emitted as:
# xxx: ${SYSTEM_DEP} swapxxx.o
#	${SYSTEM_LD_HEAD}
#	${SYSTEM_LD} swapxxx.o
#	${SYSTEM_LD_TAIL}

SYSTEM_OBJ=	locore.o fp.o ${OBJS} param.o ioconf.o ${LIBKERN} \
		${LIBCOMPAT}
#
SYSTEM_DEP=	Makefile ${SYSTEM_OBJ}
SYSTEM_LD_HEAD=	rm -f $@
SYSTEM_LD=	-@if [ X${DEBUG} = X-g ]; \
		then strip=-X; \
		else strip=-x; \
		fi; \
		echo ${LD} $$strip -o $@ -e start -T ../../conf/ld.script \
			'$${SYSTEM_OBJ}' vers.o; \
		${LD} $$strip -o $@ -e start -T ../../conf/ld.script \
			${SYSTEM_OBJ} vers.o
#
SYSTEM_LD_TAIL=	chmod 755 $@; \
		elf2ecoff $@ $@.ecoff; \
		size $@

%LOAD

newvers:
	sh $S/conf/newvers.sh
	${CC} $(CFLAGS) -c vers.c

clean::
	rm -f eddep bsd bsd.gdb bsd.ecoff tags *.o locore.i [a-z]*.s \
	    Errs errs linterrs makelinks

lint: /tmp param.c
	@lint -hbxn -DGENERIC -Dvolatile= ${COPTS} ${PARAM} -UKGDB \
	    ${CFILES} ioconf.c param.c

symbols.sort: ${ARC}/arc/symbols.raw
	grep -v '^#' ${ARC}/arc/symbols.raw \
	    | sed 's/^	//' | sort -u > symbols.sort

locore.o: ${ARC}/arc/locore.S ${MIPS}/include/asm.h \
	${MIPS}/include/cpu.h ${MIPS}/include/reg.h assym.h
	${NORMAL_S} -mips3 ${ARC}/arc/locore.S

fp.o: ${MIPS}/mips/fp.S ${MIPS}/include/asm.h \
	${ARC}/include/cpu.h ${MIPS}/include/reg.h assym.h
	${NORMAL_S} -mips3 ${MIPS}/mips/fp.S

# the following are necessary because the files depend on the types of
# cpu's included in the system configuration
clock.o machdep.o autoconf.o conf.o: Makefile

# depend on network configuration
uipc_domain.o uipc_proto.o vfs_conf.o: Makefile
if_tun.o if_loop.o if_ethersubr.o: Makefile
in_proto.o: Makefile

assym.h: $S/kern/genassym.sh ${ARC}/arc/genassym.cf
	sh $S/kern/genassym.sh ${CC} ${CFLAGS} ${CPPFLAGS} \
	    ${PARAM} < ${ARC}/arc/genassym.cf > assym.h.tmp && \
	    mv -f assym.h.tmp assym.h

links:
	egrep '#if' ${CFILES} | sed -f $S/conf/defines | \
	  sed -e 's/:.*//' -e 's/\.c/.o/' | sort -u > dontlink
	echo ${CFILES} | tr -s ' ' '\12' | sed 's/\.c/.o/' | \
	  sort -u | comm -23 - dontlink | \
	  sed 's,../.*/\(.*.o\),rm -f \1;ln -s ../GENERIC/\1 \1,' > makelinks
	sh makelinks && rm -f dontlink

tags:
	@echo "see $S/kern/Makefile for tags"

ioconf.o: ioconf.c
	${NORMAL_C}

param.c: $S/conf/param.c
	rm -f param.c
	cp $S/conf/param.c .

param.o: param.c Makefile
	${NORMAL_C_C}

newvers: ${SYSTEM_DEP} ${SYSTEM_SWAP_DEP}
	sh $S/conf/newvers.sh
	${CC} ${CFLAGS} ${CPPFLAGS} ${PROF} -c vers.c

depend:: .depend
.depend: ${SRCS} assym.h param.c
	mkdep ${AFLAGS} ${CPPFLAGS} ${ARC}/arc/locore.s
	mkdep -a ${CFLAGS} ${CPPFLAGS} param.c ioconf.c ${CFILES}
	mkdep -a ${AFLAGS} ${CPPFLAGS} ${SFILES}

%RULES


job:  #589  It is impressive how this small bit of code was able to declare a unique transient variable in the calling scope and then use it to carry string values into other scopes.  However, now it is no longer needed.

.//====================================================================
.//
.// $RCSfile: q.utils.arc,v $
.//
.// (c) Copyright 1998-2013 Mentor Graphics Corporation  All rights reserved.
.//
.//====================================================================
.//
.function gen_parameter_list .// te_parm
  .param inst_ref_set v_pars
  .param boolean prefix_param_delimiter
  .param string invocation_flavor
  .//
  .assign code = ""
  .assign OAL = ""
  .select any te_parm from instances of TE_PARM
  .if ( not_empty v_pars )
    .select any te_string from instances of TE_STRING
    .assign item_count = 0
    .select many te_pars related by v_pars->TE_PAR[R2063]
    .for each te_par in te_pars
      .select one te_parm related by te_par->TE_PARM[R2091]
      .assign te_par.Order = te_parm.Order
      .assign item_count = item_count + 1
    .end for
    .assign item_number = 0
    .assign param_delimiter = ""
    .if ( prefix_param_delimiter )
      .assign param_delimiter = ","
    .end if
    .while ( item_number < item_count )
      .select any te_par related by v_pars->TE_PAR[R2063] where ( selected.Order == item_number )
      .select one v_par related by te_par->V_PAR[R2063]
      .select one v_val related by v_par->V_VAL[R800]
      .select one te_val related by v_val->TE_VAL[R2040]
      .assign OAL = ( OAL + param_delimiter ) + te_val.OAL
      .if ( "" == te_val.buffer )
        .invoke gen_value( v_val )
      .end if
      .assign code = code + param_delimiter
      .if ( 0 == te_par.By_Ref )
        .assign code = code + te_val.buffer
      .else
        .assign code = ( ( code + "&(" ) + ( te_val.buffer + ")" ) )
      .end if
      .assign param_delimiter = ", "
      .assign item_number = item_number + 1
    .end while
  .end if
  .assign te_parm.ParamBuffer = code
  .assign te_parm.OALParamBuffer = OAL
  .assign attr_result = te_parm
.end function
.//
.//====================================================================
.//
.function is_reflexive .// boolean
  .param inst_ref r_rel
  .//
  .assign result = false
  .select one r_simp related by r_rel->R_SIMP[R206]
  .if ( not_empty r_simp )
    .select many r_parts related by r_simp->R_PART[R207]
    .if ( (cardinality r_parts) > 1 )
      .select any first_r_part related by r_simp->R_PART[R207]
      .select any second_r_part related by r_simp->R_PART[R207] where (selected.OIR_ID != first_r_part.OIR_ID)
      .if ( first_r_part.Obj_ID == second_r_part.Obj_ID )
        .assign result = true
      .end if
    .else
      .select any r_part related by r_simp->R_PART[R207]
      .select one r_form related by r_simp->R_FORM[R208]
      .if ( not_empty r_form )
        .if ( r_part.Obj_ID == r_form.Obj_ID )
          .assign result = true
        .end if
      .end if
    .end if
  .else
    .select one r_assoc related by r_rel->R_ASSOC[R206]
    .if ( not_empty r_assoc )
      .select one r_aone related by r_assoc->R_AONE[R209]
      .select one r_aoth related by r_assoc->R_AOTH[R210]
      .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
        .assign result = true
      .end if
    .end if
  .end if
  .assign attr_result = result
.end function
.//------------------------------------------------
.// Note the use of p_ here.  It is hard-coded and depends upon
.// matching the prefix used in initialization population query.
.function t_oal_smt_event_parameters .// string
  .param string evt_msg_var
  .param string parameter
  .param string value
  .param integer value_type
  .param string ws
  .assign result = ""
  .select any te_eq from instances of TE_EQ
  .if ( "" == evt_msg_var )
    .assign evt_msg_var = te_eq.event_message_variable
  .end if
  .if ( 4 == value_type )
    .// string
    .select any te_string from instances of TE_STRING
    .select any te_instance from instances of TE_INSTANCE
    .assign result = "${ws}  ${te_instance.module}${te_string.strcpy}( ${evt_msg_var}->p_${parameter}, ${value} );"
  .else
    .assign result = "${ws}  ${evt_msg_var}->p_${parameter} = ${value};"
  .end if
  .assign attr_result = result
.end function

.//====================================================================
.//
.// $RCSfile: q.utils.arc,v $
.//
.// (c) Copyright 1998-2013 Mentor Graphics Corporation  All rights reserved.
.//
.//====================================================================
.//
.function gen_parameter_list .// te_parm
  .param inst_ref_set v_pars
  .param boolean prefix_param_delimiter
  .param string invocation_flavor
  .//
  .assign code = ""
  .assign OAL = ""
  .select any te_parm from instances of TE_PARM
  .if ( not_empty v_pars )
    .select any te_string from instances of TE_STRING
    .assign item_count = 0
    .select many te_pars related by v_pars->TE_PAR[R2063]
    .for each te_par in te_pars
      .select one te_parm related by te_par->TE_PARM[R2091]
      .assign te_par.Order = te_parm.Order
      .assign item_count = item_count + 1
    .end for
    .assign item_number = 0
    .assign param_delimiter = ""
    .if ( prefix_param_delimiter )
      .assign param_delimiter = ","
    .end if
    .while ( item_number < item_count )
      .select any te_par related by v_pars->TE_PAR[R2063] where ( selected.Order == item_number )
      .select one v_par related by te_par->V_PAR[R2063]
      .select one v_val related by v_par->V_VAL[R800]
      .select one te_val related by v_val->TE_VAL[R2040]
      .assign OAL = ( OAL + param_delimiter ) + te_val.OAL
      .if ( "" == te_val.buffer )
        .invoke gen_value( v_val )
      .end if
      .assign code = code + param_delimiter
      .//
      .// Determine if the parameter is of type string.
      .// If string, check to see if this parameter is actually a function.
      .// If so, declare a variable in this scope to hold the return string.
      .// Do so by traversing to the te_blk instance to add the declaration.
      .assign stringbody = false
      .if ( 0 == te_par.By_Ref )
        .select one te_dt related by v_val->S_DT[R820]->TE_DT[R2021]
        .if ( 4 == te_dt.Core_Typ )
          .// Check the four types of returnable action bodies for string.
          .select one v_trv related by v_val->V_TRV[R801]
          .if ( not_empty v_trv )
            .assign stringbody = true
          .else
          .select one v_msv related by v_val->V_MSV[R801]
          .if ( not_empty v_msv )
            .assign stringbody = true
          .else
          .select one v_brv related by v_val->V_BRV[R801]
          .if ( not_empty v_brv )
            .assign stringbody = true
          .else
          .select one v_fnv related by v_val->V_FNV[R801]
          .if ( not_empty v_fnv )
            .assign stringbody = true
          .end if
          .end if
          .end if
          .end if
          .if ( stringbody )
            .assign te_par.buffer = ( "v_sretval" + "$t{v_par.labelLineNumber}" ) + ( invocation_flavor + "$t{v_par.labelColumn}" )
            .select one te_blk related by v_val->ACT_BLK[R826]->TE_BLK[R2016]
            .assign te_blk.declaration = ( ( ( te_blk.declaration + te_dt.ExtName ) + ( " " + te_par.buffer ) ) + ( "[" + te_string.max_string_length ) ) + "];"
            .assign code = ( ( code + te_string.strcpy ) + ( "( " + te_par.buffer) ) + ", "
          .end if
        .end if
        .//
        .//
        .assign code = code + te_val.buffer
        .if ( stringbody )
          .assign code = code + ")"
        .end if
      .else
        .assign code = ( ( code + "&(" ) + ( te_val.buffer + ")" ) )
      .end if
      .assign param_delimiter = ", "
      .assign item_number = item_number + 1
    .end while
  .end if
  .assign te_parm.ParamBuffer = code
  .assign te_parm.OALParamBuffer = OAL
  .assign attr_result = te_parm
.end function
.//
.//====================================================================
.//
.function is_reflexive .// boolean
  .param inst_ref r_rel
  .//
  .assign result = false
  .select one r_simp related by r_rel->R_SIMP[R206]
  .if ( not_empty r_simp )
    .select many r_parts related by r_simp->R_PART[R207]
    .if ( (cardinality r_parts) > 1 )
      .select any first_r_part related by r_simp->R_PART[R207]
      .select any second_r_part related by r_simp->R_PART[R207] where (selected.OIR_ID != first_r_part.OIR_ID)
      .if ( first_r_part.Obj_ID == second_r_part.Obj_ID )
        .assign result = true
      .end if
    .else
      .select any r_part related by r_simp->R_PART[R207]
      .select one r_form related by r_simp->R_FORM[R208]
      .if ( not_empty r_form )
        .if ( r_part.Obj_ID == r_form.Obj_ID )
          .assign result = true
        .end if
      .end if
    .end if
  .else
    .select one r_assoc related by r_rel->R_ASSOC[R206]
    .if ( not_empty r_assoc )
      .select one r_aone related by r_assoc->R_AONE[R209]
      .select one r_aoth related by r_assoc->R_AOTH[R210]
      .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
        .assign result = true
      .end if
    .end if
  .end if
  .assign attr_result = result
.end function
.//------------------------------------------------
.// Note the use of p_ here.  It is hard-coded and depends upon
.// matching the prefix used in initialization population query.
.function t_oal_smt_event_parameters .// string
  .param string evt_msg_var
  .param string parameter
  .param string value
  .param integer value_type
  .param string ws
  .assign result = ""
  .select any te_eq from instances of TE_EQ
  .if ( "" == evt_msg_var )
    .assign evt_msg_var = te_eq.event_message_variable
  .end if
  .if ( 4 == value_type )
    .// string
    .select any te_string from instances of TE_STRING
    .select any te_instance from instances of TE_INSTANCE
    .assign result = "${ws}  ${te_instance.module}${te_string.strcpy}( ${evt_msg_var}->p_${parameter}, ${value} );"
  .else
    .assign result = "${ws}  ${evt_msg_var}->p_${parameter} = ${value};"
  .end if
  .assign attr_result = result
.end function


hl2b/hl.arc: more fixes of the emulation of <hl>defm

(in-package hl)
(using <arc>v3)

(mac <hl>def (spec . rest)
  (if
    (acons spec)
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,(car spec)
             ; should really be <hl>fn, but for now we use
             ; <axiom>lambda
             (<axiom>lambda ,(cdr spec)
               ,@rest))))
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,spec
             ,(car rest))))))
(mac <hl>defm (sig . rest)
  (withs (f  (rep <arc>defm)
          rv (apply f (car sig) (cdr sig) rest)
          (set-axiom var (poly-fn types (fn-axiom parms . body) old))
             rv)
    ; NOTE! differences in <arc>polymorph and
    ; <hl>polymorph:
    ;   (<arc>polymorph signature generic specific)
    ;   (<hl>polymorph generic signature specific)
    ; - the change in order was done since we might
    ;   want to overload how overloading of particular
    ;   objects as generics are done
    ; wrap in w/gvl
    `((<axiom>symeval '<common>call-w/gvl)
      (<axiom>lambda ()
        (<axiom>set ,var (<hl>polymorph ,old ,types (<axiom>lambda ,parms ,@body)))))))

(def <common>call-w/gvl (f) (f))

(in-package hl)
(using <arc>v3)

(mac <hl>def (spec . rest)
  (if
    (acons spec)
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,(car spec)
             ; should really be <hl>fn, but for now we use
             ; <axiom>lambda
             (<axiom>lambda ,(cdr spec)
               ,@rest))))
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,spec
             ,(car rest))))))
(mac <hl>defm (sig . rest)
  (withs (f  (rep <arc>defm)
          rv (apply f (car sig) (cdr sig) rest)
          (set-axiom var (poly-fn types old new))
             rv)
    ; NOTE! differences in <arc>polymorph and
    ; <hl>polymorph:
    ;   (<arc>polymorph signature generic specific)
    ;   (<hl>polymorph generic signature specific)
    ; - the change in order was done since we might
    ;   want to overload how overloading of particular
    ;   objects as generics are done
    ; wrap in w/gvl
    `((<axiom>symeval '<common>call-w/gvl)
      (<axiom>lambda ()
        (<axiom>set ,var (<hl>polymorph ,old ,types ,new))))))

(def <common>call-w/gvl (f) (f))


job:  #9554  added a first step toward referential checking only on participant

.// TODO - compare referential attribute values
.// TODO - _exactly_ one subtype
.//
.// Iterate over the given class.
.function t_class_instance_iteration .// string
  .param string key_letters
  .param string inner_body
select many $l{key_letters}s from instances of ${key_letters};
for each $l{key_letters} in $l{key_letters}s
${inner_body}
end for;
.end function
.//
.// Ensure no duplicate instance identifiers.
.function t_duplication .// string
  .param string key_letters
  .param string where_clause
  .param integer Numb
  select many duplicate_$l{key_letters}s from instances of ${key_letters} where ( ${where_clause} );
  if ( cardinality duplicate_$l{key_letters}s != 1 )
    LOG::LogInfo( message: "uniqueness violation in ${key_letters} for identifier $t{Numb}" );
    break;
  end if;
.end function
.//
.// Select across link to required instance.
.function t_participation .// string
  .param string left_side
  .param string right_side
  .param integer Numb
  .param string multiplicity
  .param string phrase
  .param string attribute_comparison
  .if ( "" != phrase )
  select ${multiplicity} $l{right_side} related by $l{left_side}->${right_side}[R$t{Numb}.'${phrase}'];
  .else
  select ${multiplicity} $l{right_side} related by $l{left_side}->${right_side}[R$t{Numb}];
  .end if
  if ( empty $l{right_side} )
  .if ( "" != phrase )
    LOG::LogInfo( message: "instance not found ${left_side}->${right_side}[R$t{Numb}.'${phrase}']" );
  .else
    LOG::LogInfo( message: "instance not found ${left_side}->${right_side}[R$t{Numb}]" );
  .end if
    break;
  .if ( "" != attribute_comparison )
  else
    if ( not ( ${attribute_comparison} ) )
      LOG::LogInfo( message: "referentials do not match identifiers between ${left_side} and ${right_side}" );
      break;
    end if;
  .end if
  end if;
.end function
.//
.// Loop through looking for a subtype.
.function t_supertype_loop .// string
  .param string super
  .param integer Numb
  .param string Loop_Body
${Loop_Body}
  LOG::LogInfo( message: "subtype not found from ${super} across R$t{Numb}" );
  break;
.end function
.//
.// Be sure supertype is present.
.function t_sub_to_super .// string
  .param string sub
  .param string super
  .param integer Numb
  select one $l{super} related by $l{sub}->${super}[R$t{Numb}];
  if ( empty $l{super} )
    LOG::LogInfo( message: "supertype not found across ${sub}->${super}[R$t{Numb}]" );
    break;
  end if;
.end function
.//
.// Look for a particular subtype.
.function t_super_to_sub .// string
  .param string super
  .param string sub
  .param integer Numb
  select one $l{sub} related by $l{super}->${sub}[R$t{Numb}];
  if ( not_empty $l{sub} )
    continue;
  end if;
.end function
.//
.function instance_uniqueness .// string
  .param inst_ref o_id
  .select one o_obj related by o_id->O_OBJ[R104]
  .assign where_clause = ""
  .assign prefix = ""
  .select many o_oidas related by o_id->O_OIDA[R105]
  .for each o_oida in o_oidas
    .assign clause = "selected." + o_oida.localAttributeName + " == " + $l{o_obj.Key_Lett} + "." + o_oida.localAttributeName
    .assign where_clause = where_clause + prefix + clause
    .assign prefix = " and "
  .end for
  .invoke r = t_duplication( o_obj.Key_Lett, where_clause, o_id.Oid_ID + 1 )
${r.body}
.end function
.//
.function compare_referentials_to_identifiers
  .param string rto_name
  .param string rgo_name
  .param inst_ref r_rto
  .param inst_ref r_rgo
  .//
  .assign where_clause = ""
  .assign conjunction = ""
  .select many o_oidas related by r_rto->O_ID[R109]->O_OIDA[R105]
  .for each o_oida in o_oidas
    .// Get the identifying attribute corresponding to this <o_oida> instance.
    .select any o_attr related by o_oida->O_ATTR[R105] where (selected.Attr_ID == o_oida.Attr_ID)
    .select any o_rtida related by r_rto->O_RTIDA[R110] where ((selected.Attr_ID == o_oida.Attr_ID) and ((selected.Obj_ID == o_oida.Obj_ID) and (selected.Oid_ID == o_oida.Oid_ID)))
    .// There can be more than one valid O_REF here, so get _any_ one.
    .// Note:  If MANY <o_rtida>, we need to rip through the (possible) combined referentials,
    .// unlinking any non-constrained elements.
    .select any o_ref related by o_rtida->O_REF[R111] where ( (selected.Obj_ID == r_rgo.Obj_ID) and (selected.OIR_ID == r_rgo.OIR_ID) )
    .// Get the referential attribute corresponding to the current <o_attr>.
    .select one ref_o_attr related by o_ref->O_RATTR[R108]->O_ATTR[R106]
    .select one o_dbattr related by o_attr->O_BATTR[R106]->O_DBATTR[R107]
    .// template here
    .assign clause = rto_name + "." + o_attr.Name + " == " + rgo_name + "." + ref_o_attr.Name
    .assign where_clause = where_clause + conjunction + clause
    .assign conjunction = " and "
  .end for
${where_clause}\
.end function
.//
.function participant_participation .// string
  .param inst_ref o_obj
  .select many r_parts related by o_obj->R_OIR[R201]->R_RTO[R203]->R_PART[R204]
  .for each r_part in r_parts
    .select one r_simp related by r_part->R_SIMP[R207]
    .select one r_rel related by r_simp->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_form related by r_simp->R_FORM[R208]
      .if ( not_empty r_form )
        .if ( not r_form.Cond )
          .select one r_rgo related by r_form->R_RGO[R205]
          .select one target_o_obj related by r_rgo->R_OIR[R203]->O_OBJ[R201]
          .assign card = "one"
          .if ( r_form.Mult )
            .assign card = "any"
          .end if
          .assign phrase = ""
          .if ( r_part.Obj_ID == r_form.Obj_ID )
            .assign phrase = r_form.Txt_Phrs
          .end if
          .select one r_rto related by r_part->R_RTO[R204]
          .invoke r = compare_referentials_to_identifiers( $l{o_obj.Key_Lett}, $l{target_o_obj.Key_Lett}, r_rto, r_rgo )
          .assign comparison = r.body
          .invoke r = t_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, card, phrase, comparison )
  // participant participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
        .end if
      .else
  // unformalized association R$t{r_rel.Numb}
      .end if
    .end if
  .end for
.end function
.//
.function formalizer_participation .// string
  .param inst_ref o_obj
  .select many r_forms related by o_obj->R_OIR[R201]->R_RGO[R203]->R_FORM[R205]
  .for each r_form in r_forms
    .select one r_simp related by r_form->R_SIMP[R208]
    .select one r_rel related by r_simp->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_part related by r_simp->R_PART[R207]
      .if ( not r_part.Cond )
        .select one target_o_obj related by r_part->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
        .assign card = "one"
        .if ( r_part.Mult )
          .assign card = "any"
        .end if
        .assign phrase = ""
        .if ( r_part.Obj_ID == r_form.Obj_ID )
          .assign phrase = r_part.Txt_Phrs
        .end if
        .invoke r = t_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, card, phrase, "" )
  // formalizer participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
      .end if
    .end if
  .end for
.end function
.//
.function associator_participation .// string
  .param inst_ref o_obj
  .select many r_assrs related by o_obj->R_OIR[R201]->R_RGO[R203]->R_ASSR[R205]
  .for each r_assr in r_assrs
    .select one r_assoc related by r_assr->R_ASSOC[R211]
    .select one r_rel related by r_assoc->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_aone related by r_assoc->R_AONE[R209]
      .select one r_aoth related by r_assoc->R_AOTH[R210]
      .select one aone_o_obj related by r_aone->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
      .select one aoth_o_obj related by r_aoth->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
      .assign phrase = ""
      .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
        .assign phrase = r_aone.Txt_Phrs
      .end if
      .invoke r = t_participation( o_obj.Key_Lett, aone_o_obj.Key_Lett, r_rel.Numb, "one", phrase, "" )
  // associator one participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${aone_o_obj.Name}(${aone_o_obj.Key_Lett})
${r.body}
      .assign phrase = ""
      .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
        .assign phrase = r_aoth.Txt_Phrs
      .end if
      .invoke r = t_participation( o_obj.Key_Lett, aoth_o_obj.Key_Lett, r_rel.Numb, "one", phrase, "" )
  // associator other participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${aoth_o_obj.Name}(${aoth_o_obj.Key_Lett})
${r.body}
    .end if
  .end for
.end function
.//
.function aone_participation .// string
  .param inst_ref o_obj
  .select many r_aones related by o_obj->R_OIR[R201]->R_RTO[R203]->R_AONE[R204]
  .for each r_aone in r_aones
    .select one r_assoc related by r_aone->R_ASSOC[R209]
    .select one r_rel related by r_assoc->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_aoth related by r_assoc->R_AOTH[R210]
      .if ( not r_aoth.Cond )
        .select one target_o_obj related by r_assoc->R_ASSR[R211]->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
        .assign phrase = ""
        .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
          .assign phrase = r_aoth.Txt_Phrs
        .end if
        .assign card = "one"
        .if ( r_aoth.Mult )
          .assign card = "any"
        .end if
        .invoke r = t_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, card, phrase, "" )
  // aone participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
      .end if
    .end if
  .end for
.end function
.//
.function aoth_participation .// string
  .param inst_ref o_obj
  .select many r_aoths related by o_obj->R_OIR[R201]->R_RTO[R203]->R_AOTH[R204]
  .for each r_aoth in r_aoths
    .select one r_assoc related by r_aoth->R_ASSOC[R210]
    .select one r_rel related by r_assoc->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_aone related by r_assoc->R_AONE[R209]
      .if ( not r_aone.Cond )
        .select one target_o_obj related by r_assoc->R_ASSR[R211]->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
        .assign phrase = ""
        .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
          .assign phrase = r_aone.Txt_Phrs
        .end if
        .assign card = "one"
        .if ( r_aone.Mult )
          .assign card = "any"
        .end if
        .invoke r = t_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, card, phrase, "" )
  // aoth participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
      .end if
    .end if
  .end for
.end function
.//
.function supertype_participation .// string
  .param inst_ref o_obj
  .assign loop_body = ""
  .select many r_supers related by o_obj->R_OIR[R201]->R_RTO[R203]->R_SUPER[R204]
  .for each r_super in r_supers
    .select one r_subsup related by r_super->R_SUBSUP[R212]
    .select one r_rel related by r_subsup->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select many r_subs related by r_subsup->R_SUB[R213]
      .for each r_sub in r_subs
        .select one source_o_obj related by r_sub->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
        .invoke r = t_super_to_sub( o_obj.Key_Lett, source_o_obj.Key_Lett, r_rel.Numb )
        .assign loop_body = loop_body + r.body
      .end for
      .invoke r = t_supertype_loop( o_obj.Key_Lett, r_rel.Numb, loop_body )
  // super to sub participation R$t{r_rel.Numb}:  supertype ${o_obj.Name}(${o_obj.Key_Lett})
${r.body}
    .end if
  .end for
.end function
.//
.function subtype_participation .// string
  .param inst_ref o_obj
  .select many r_subs related by o_obj->R_OIR[R201]->R_RGO[R203]->R_SUB[R205]
  .for each r_sub in r_subs
    .select one r_subsup related by r_sub->R_SUBSUP[R213]
    .select one r_rel related by r_subsup->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one target_o_obj related by r_subsup->R_SUPER[R212]->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
      .invoke r = t_sub_to_super( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb )
  // sub to super participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
    .end if
  .end for
.end function
.//
.// Return true if the element exists (nested) in the given package name.
.function in_ep_pkg .// boolean
  .param inst_ref ep_pkg
  .param string ep_pkg_Name
  .assign inpkg = false
  .if ( not_empty ep_pkg )
    .if ( ep_pkg_Name == ep_pkg.Name )
      .assign inpkg = true
    .else
      .select one ep_pkg related by ep_pkg->PE_PE[R8001]->EP_PKG[R8000]
      .invoke r = in_ep_pkg( ep_pkg, ep_pkg_Name )
      .assign inpkg = r.result
    .end if
  .end if
  .assign attr_result = inpkg
.end function
.//
.function generate_actions .// string
// For each class in the model do the following:
//   Search for duplicate identifiers in the instance extent.
//   Find unconditional formalizer from a participant in a simple association.
//   Find unconditional participant from a formalizer in a simple association.
//   For an associator in a linked association ensure both ends have an instance.
//   For the one end of an associative, find the unconditional associator.
//   For the other end of an associative, find the unconditional associator.
//   For a subtype, be sure a supertype is present.
//   For a supertype, be sure exactly one subtype is present.
// Show only the first violation of any particular rule in each extent.
  .select many o_objs from instances of O_OBJ
  .for each o_obj in o_objs
    .select one ep_pkg related by o_obj->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .assign text = ""
      .select many o_ids related by o_obj->O_ID[R104]
      .for each o_id in o_ids
        .select one o_oida related by o_id->O_OIDA[R105]
        .if ( not_empty o_oida )
          .invoke r = instance_uniqueness( o_id )
          .assign text = text + r.body
        .end if
      .end for
      .// participant
      .invoke r = participant_participation( o_obj )
      .assign text = text + r.body
      .// formalizer
      .invoke r = formalizer_participation( o_obj )
      .assign text = text + r.body
      .// associator
      .invoke r = associator_participation( o_obj )
      .assign text = text + r.body
      .// aone
      .invoke r = aone_participation( o_obj )
      .assign text = text + r.body
      .// aoth
      .invoke r = aoth_participation( o_obj )
      .assign text = text + r.body
      .// subtype
      .invoke r = subtype_participation( o_obj )
      .assign text = text + r.body
      .// supertype
      .invoke r = supertype_participation( o_obj )
      .assign text = text + r.body
      .// iterate
      .invoke r = t_class_instance_iteration( o_obj.Key_Lett, text )
${r.body}
    .end if
  .end for
  .//
.end function
.//
.function ooaofooa_check_referential_integrity .// string
  .invoke r = generate_actions()
${r.body}
.end function
.//
.invoke r = ooaofooa_check_referential_integrity()
${r.body}
.emit to file "../ooa.txt"

.// Get rid of double 'r_form'
.// Be sure supertype does not allow more than one.
.// Be sure we are checking atleastone on Sub/Super.
.//
.function class_instance_iteration1 .// string
  .param string key_letters
  .param string inner_body
select many $l{key_letters}s from instances of ${key_letters};
for each $l{key_letters} in $l{key_letters}s
${inner_body}\
.end function
.//
.function class_instance_iteration2 .// string
end for;
.end function
.//
.function constraint_tmpl .// string
  .param string key_letters
  .param string Where_Clause
  .param integer Numb
  select many duplicate_$l{key_letters}s from instances of ${key_letters} where (${Where_Clause});
  if ( cardinality duplicate_$l{key_letters}s != 1 )
    LOG::LogInfo(message: "uniqueness violation in ${key_letters} for identifier $t{Numb}");
    break;
  end if;
.end function
.//
.function sub_to_super .// string
  .param string sub
  .param string super
  .param integer Numb
  select one $l{super} related by $l{sub}->${super}[R$t{Numb}];
  if ( empty $l{super} )
    LOG::LogInfo(message: "supertype not found across ${sub}->${super}[R$t{Numb}]");
    break;
  end if;
.end function
.//
.function simple_participation .// string
  .param string From
  .param string To
  .param integer Numb
  .param string multiplicity
  .param string phrase
.if ( "" != phrase )
  select ${multiplicity} $l{To} related by $l{From}->${To}[R$t{Numb}.'${phrase}'];
.else
  select ${multiplicity} $l{To} related by $l{From}->${To}[R$t{Numb}];
.end if
  if ( empty $l{To} )
    LOG::LogInfo(message: "instance not found ${From}->${To}[R$t{Numb}.'${phrase}']");
    break;
  end if;
.end function
.//
.function atleast_one_tmpl .// string
  .param string From
  .param string To
  .param integer Numb
  .param string multiplicity
  .param string phrase
select many $l{From}s from instances of ${From};
for each $l{From} in $l{From}s
.if ( "" != phrase )
  select ${multiplicity} $l{To} related by $l{From}->${To}[R$t{Numb}.'${phrase}'];
.else
  select ${multiplicity} $l{To} related by $l{From}->${To}[R$t{Numb}];
.end if
  if ( empty $l{To} )
    LOG::LogInfo(message: "Integrity violation in ${From}->${To}[R$t{Numb}.'${phrase}']");
    break;
  end if;
end for;
.end function
.//
.function supertype_loop_tmpl .// string
  .param string From
  .param integer Numb
  .param string Loop_Body
${Loop_Body}
  LOG::LogInfo(message: "subtype not found from ${From} across R$t{Numb}");
  break;
.end function
.//
.function super_to_sub .// string
  .param string From
  .param string To
  .param integer Numb
  select one $l{To} related by $l{From}->${To}[R$t{Numb}];
  if ( not_empty $l{To} )
    continue;
  end if;
.end function
.//
.// Return true if the element exists (nested) in the given package name.
.function in_ep_pkg .// boolean
  .param inst_ref ep_pkg
  .param string ep_pkg_Name
  .assign inpkg = false
  .if ( not_empty ep_pkg )
    .if ( ep_pkg_Name == ep_pkg.Name )
      .assign inpkg = true
    .else
      .select one ep_pkg related by ep_pkg->PE_PE[R8001]->EP_PKG[R8000]
      .invoke r = in_ep_pkg( ep_pkg, ep_pkg_Name )
      .assign inpkg = r.result
    .end if
  .end if
  .assign attr_result = inpkg
.end function
.//
.function participant_participation .// string
  .param inst_ref o_obj
  .select many r_parts related by o_obj->R_OIR[R201]->R_RTO[R203]->R_PART[R204]
  .for each r_part in r_parts
    .select one r_simp related by r_part->R_SIMP[R207]
    .select one r_rel related by r_simp->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_form related by r_simp->R_FORM[R208]
      .if ( not_empty r_form )
        .select one target_o_obj related by r_simp->R_FORM[R208]->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
        .if ( not r_form.Cond )
          .assign cardinality = "one"
          .if ( r_form.Mult )
            .assign cardinality = "any"
          .end if
          .assign phrase = ""
          .if ( r_part.Obj_ID == r_form.Obj_ID )
            .assign phrase = r_form.Txt_Phrs
          .end if
          .invoke r = simple_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, cardinality, phrase )
  // participant participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
        .end if
      .else
  // unformalized association R$t{r_rel.Numb}
      .end if
    .end if
  .end for
.end function
.//
.function formalizer_participation .// string
  .param inst_ref o_obj
  .select many r_forms related by o_obj->R_OIR[R201]->R_RGO[R203]->R_FORM[R205]
  .for each r_form in r_forms
    .select one r_simp related by r_form->R_SIMP[R208]
    .select one r_rel related by r_simp->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_part related by r_simp->R_PART[R207]
      .select one target_o_obj related by r_simp->R_PART[R207]->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
      .if ( not r_part.Cond )
        .assign cardinality = "one"
        .if ( r_part.Mult )
          .assign cardinality = "any"
        .end if
        .assign phrase = ""
        .if ( r_part.Obj_ID == r_form.Obj_ID )
          .assign phrase = r_part.Txt_Phrs
        .end if
        .invoke r = simple_participation( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, cardinality, phrase )
  // formalizer participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
      .end if
    .end if
  .end for
.end function
.//
.function check_link
  .param inst_ref r_rto
  .param inst_ref r_rel
  .param inst_ref source_o_obj
  .param integer Cond
  .param integer Mult
  .param string phrase
  .select one target_o_obj related by r_rto->R_OIR[R203]->O_OBJ[R201]
  .assign text = ""
  .assign cardinality = ""
  .if ( Mult )
    .assign cardinality = "one"
  .else
    .assign cardinality = "one"
  .end if
  .invoke r = atleast_one_tmpl(source_o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb, cardinality, phrase)
  .assign text = r.body
  .if ( not Cond )
    .if ( Mult )
      .assign cardinality = "any"
    .else
      .assign cardinality = "one"
    .end if
    .invoke r = atleast_one_tmpl(target_o_obj.Key_Lett, source_o_obj.Key_Lett, r_rel.Numb, cardinality, phrase)
    .assign text = text + r.body
  .end if
${text}
.end function
.//
.function mk_linked_association_check .// string
  .param inst_ref r_assoc
  .select one r_rel related by r_assoc->R_REL[R206]
  .select one r_rgo related by r_assoc->R_ASSR[R211]->R_RGO[R205]
  .select one source_o_obj related by r_rgo->R_OIR[R203]->O_OBJ[R201]
  .select one r_aone related by r_assoc->R_AONE[R209]
  .select one r_aoth related by r_assoc->R_AOTH[R210]
  .assign phrase = ""
  .if ( r_aone.Obj_ID == r_aoth.Obj_ID )
    .// reflexive
    .assign phrase = r_aoth.Txt_Phrs
  .end if
  .select one r_rto related by r_aone->R_RTO[R204]
  .invoke r1 = check_link( r_rto, r_rel, source_o_obj, r_aoth.Cond, r_aoth.Mult, phrase )
  .assign phrase = ""
  .if ( r_aoth.Obj_ID == r_aone.Obj_ID )
    .// reflexive
    .assign phrase = r_aone.Txt_Phrs
  .end if
  .select one r_rto related by r_aoth->R_RTO[R204]
  .invoke r2 = check_link( r_rto, r_rel, source_o_obj, r_aone.Cond, r_aone.Mult, phrase )
// associative relationship R$t{r_rel.Numb}:  ${source_o_obj.Name}(${source_o_obj.Key_Lett})
${r1.body}${r2.body}
.end function
.//
.function supertype_participation .// string
  .param inst_ref o_obj
  .assign loop_body = ""
  .select many r_supers related by o_obj->R_OIR[R201]->R_RTO[R203]->R_SUPER[R204]
  .for each r_super in r_supers
    .select one r_subsup related by r_super->R_SUBSUP[R212]
    .select one r_rel related by r_subsup->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select many r_subs related by r_subsup->R_SUB[R213]
      .for each r_sub in r_subs
        .select one source_o_obj related by r_sub->R_RGO[R205]->R_OIR[R203]->O_OBJ[R201]
        .invoke r = super_to_sub( o_obj.Key_Lett, source_o_obj.Key_Lett, r_rel.Numb )
        .assign loop_body = loop_body + r.body
      .end for
      .invoke r = supertype_loop_tmpl( o_obj.Key_Lett, r_rel.Numb, loop_body )
  // super to sub participation R$t{r_rel.Numb}:  supertype ${o_obj.Name}(${o_obj.Key_Lett})
${r.body}
    .end if
  .end for
.end function
.//
.function subtype_participation .// string
  .param inst_ref o_obj
  .select many r_subs related by o_obj->R_OIR[R201]->R_RGO[R203]->R_SUB[R205]
  .for each r_sub in r_subs
    .select one r_subsup related by r_sub->R_SUBSUP[R213]
    .select one r_rel related by r_subsup->R_REL[R206]
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one target_o_obj related by r_subsup->R_SUPER[R212]->R_RTO[R204]->R_OIR[R203]->O_OBJ[R201]
      .invoke r = sub_to_super( o_obj.Key_Lett, target_o_obj.Key_Lett, r_rel.Numb )
  // sub to super participation R$t{r_rel.Numb}:  ${o_obj.Name}(${o_obj.Key_Lett}) -> ${target_o_obj.Name}(${target_o_obj.Key_Lett})
${r.body}
    .end if
  .end for
.end function
.//
.function instance_uniqueness .// string
  .param inst_ref o_id
  .select one o_obj related by o_id->O_OBJ[R104]
  .assign where_clause = ""
  .assign prefix = ""
  .select many o_oidas related by o_id->O_OIDA[R105]
  .for each o_oida in o_oidas
    .assign clause = "(selected." + o_oida.localAttributeName + " == " + $l{o_obj.Key_Lett} + "." + o_oida.localAttributeName + ")"
    .assign where_clause = where_clause + prefix + clause
    .assign prefix = " and "
  .end for
  .invoke r = constraint_tmpl(o_obj.Key_Lett, where_clause, o_id.Oid_ID + 1)
${r.body}
.end function
.//
.function generate_actions .// string
  .assign text = ""
  .select many r_rels from instances of R_REL
  .for each r_rel in r_rels
    .select one ep_pkg related by r_rel->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .select one r_assoc related by r_rel->R_ASSOC[R206]
      .if ( not_empty r_assoc )
        .//.invoke r = mk_linked_association_check( r_assoc )
        .//.assign text = text + r.body
      .end if
    .end if
  .end for
  .//
  .assign text = ( text + "\n" ) + "// instance uniqueness queries\n"
  .select many o_objs from instances of O_OBJ
  .for each o_obj in o_objs
    .select one ep_pkg related by o_obj->PE_PE[R8001]->EP_PKG[R8000]
    .invoke r = in_ep_pkg( ep_pkg, "ooaofooa" )
    .if ( r.result )
      .invoke r = class_instance_iteration1( o_obj.Key_Lett, "" )
      .assign text = text + r.body
      .assign text = text + "  // instance uniqueness query\n"
      .select many o_ids related by o_obj->O_ID[R104]
      .for each o_id in o_ids
        .select one o_oida related by o_id->O_OIDA[R105]
        .if ( not_empty o_oida )
          .invoke r = instance_uniqueness(o_id)
          .assign text = text + r.body
        .end if
      .end for
      .// participant
      .invoke r = participant_participation( o_obj )
      .assign text = text + r.body
      .// formalizer
      .invoke r = formalizer_participation( o_obj )
      .assign text = text + r.body
      .// subtype
      .invoke r = subtype_participation( o_obj )
      .assign text = text + r.body
      .// supertype
      .invoke r = supertype_participation( o_obj )
      .assign text = text + r.body
      .invoke r = class_instance_iteration2()
      .assign text = text + r.body
    .end if
  .end for
  .//
  .assign text = ( text + "\n" ) + "return true;"
${text}
.end function
.//
.function ooaofooa_check_referential_integrity .// string
  .invoke r = generate_actions()
${r.body}
.end function
.//
.invoke r = ooaofooa_check_referential_integrity()
${r.body}
.emit to file "../ooa.txt"