$! --- University of Sussex POPLOG file -----------------------------------
$! File:            $usepop/master/C.vms/com/expoplink.com
$! Purpose:         create a saved image with expternal files linked in
$! Author:          John Gibson, Januage 1985
$! Documentation:   REF * EXTERNAL
$! Related Files:
$
$ ! This file simulates the operation of the old mechanism for linking
$ ! external procedures with POPLOG. It uses EXTERNAL_LOAD to load the
$ ! specified object files and then creates a POPLOG saved image. The
$ ! arguments are the same as for the old EXPOPLINK, except that the name
$ ! for the executable image is replaced by the name for the saved image, viz
$ !
$ !     @[POP.COM]EXPOPLINK <saved image name> <sym file name>
$ !                                             {<obj file names>, ...}
$ !
$ ! The saved image can then be run with
$ !
$ !                 POP11 /<saved image name>
$
$
$ on error then exit
$ pop11 sys$input: 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8'

procedure();
    lvars itemlist symlist name popname wkmem char rep files n;
    unless length(poparglist) > 2 then
        mishap(0, 'EXPOPLINK: INSUFFICIENT ARGUMENTS')
    endunless;
    incharitem(discin(poparglist(2))) -> itemlist;
    item_chartype(`_`) -> item_chartype(`$`, itemlist);
    pdtolist(itemlist) -> itemlist;
    0 -> wkmem;
    [%until null(itemlist) do
        dest(itemlist) -> itemlist -> name;
        if name == "alloc_mem" or name == "ALLOC_MEM" then
            if null(itemlist)
            or (dest(itemlist) -> itemlist -> wkmem;
                not(isinteger(wkmem)) or wkmem < 0)
            then
                mishap(0, 'BAD VALUE FOR ALLOC_MEM');
            else
                nextloop
            endif
        elseif lmember(name, [procedure PROCEDURE absolute ABSOLUTE]) then
            if name ==  "PROCEDURE" then "procedure" -> name
            elseif name  == "ABSOLUTE" then "absolute" -> name
            endif;
            {type ^name}
        else
            name -> popname;
            unless null(itemlist) or hd(itemlist) /== "->" then
                dest(tl(itemlist)) -> itemlist -> popname
            endunless;
            [^name ^popname]
        endif;
    enduntil%] -> symlist;
    incharitem(stringin('',
        for name in tl(tl(poparglist)) do <>name<>'\s' endfor)) -> rep;
    for char in [`[` `]` `.` `;` `:` `-` `$` `/`] do
        item_chartype(`a`) -> item_chartype(char, rep)
    endfor;
    item_chartype(`\s`) -> item_chartype(`,`, rep);
    maplist(pdtolist(rep), nonop >< (%''%)) -> files;
    external_load('expoplink_load', files, symlist, wkmem);
    poparglist(1) -> name;
    if locchar(`]`, 1, name) ->> n then n+1 else 1 endif -> n;
    if locchar(`.`, n, name) then name else name <> '.psv' endif;
endprocedure();

if syssave() then
    pr(popheader), pr(newline);
    setpop()
endif;