home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / jade-3.0.lha / Jade / src / amiga_misc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-04-19  |  15.1 KB  |  632 lines
  1. /* amiga_misc.c -- Miscellaneous functions for AmigaDOS
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. This file is part of Jade.
  5.  
  6. Jade is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. Jade is distributed in the hope that it will be useful, but
  12. WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with Jade; see the file COPYING.    If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22.  
  23. #include <clib/dos_protos.h>
  24. #define INTUI_V36_NAMES_ONLY
  25. #include <clib/intuition_protos.h>
  26. #include <clib/asl_protos.h>
  27. #include <exec/initializers.h>
  28. #include <string.h>
  29. #include <stdlib.h>
  30.  
  31. _PR void killfilereq(void);
  32. _PR void beep(VW *);
  33. _PR bool samefiles(u_char *, u_char *);
  34. _PR u_char *filepart(u_char *);
  35. _PR void NewList(struct List *);
  36. _PR VALUE geterrstring(void);
  37. _PR void doconmsg(u_char *);
  38. _PR u_char *squirrelfile(u_char *);
  39. _PR VALUE valsquirrelfile(u_char *);
  40.  
  41. _PR int fileexists(u_char *);
  42. _PR long filemodtime(u_char *);
  43. _PR long getsystime(void);
  44. _PR int addfilepart(u_char *, u_char *, int);
  45.  
  46. _PR void sys_misc_init(void);
  47.  
  48. /*
  49.  * File req stuff.
  50.  * I don't like the ASL requester but I couldn't be bothered to make the DICE
  51.  * libraries for reqtools.library. Use the RTpatch prog to get nice (fast)
  52.  * requesters.
  53.  */
  54.     void             *AslBase;
  55. static    struct FileRequester *FileReq;
  56.  
  57. void
  58. killfilereq(void)
  59. {
  60.     if(FileReq)
  61.     {
  62.     FreeAslRequest(FileReq);
  63.     FileReq = NULL;
  64.     }
  65.     if(AslBase)
  66.     {
  67.     CloseLibrary(AslBase);
  68.     AslBase = NULL;
  69.     }
  70. }
  71.  
  72. _PR VALUE cmd_file_req(VALUE title, VALUE filename, VALUE writep);
  73. DEFUN("file-req", cmd_file_req, subr_file_req, (VALUE title, VALUE filename, VALUE writep), V_Subr3, DOC_file_req) /*
  74. ::doc:file_req::
  75. (file-req TITLE [FILE-NAME] [FOR-WRITING-P])
  76. *AMIGA ONLY*
  77. Displays a file requester (standard one from asl.library) asking for the name
  78. of a file. FOR-WRITING-P should be non-nil if the file being requested for
  79. will be written to. TITLE is the name of the requester. FILE-NAME is
  80. the starting value for the filename.
  81.  
  82. If a filename is selected its name is returned (a string), else this
  83. function returns nil.
  84. ::end:: */
  85. {
  86.     VALUE result = sym_nil;
  87.     DECLARE1(title, STRINGP);
  88.     if(!STRINGP(filename))
  89.     filename = NullString;
  90.     if(AslBase || (AslBase = OpenLibrary("asl.library", 36)))
  91.     {
  92.     if(FileReq
  93.        || (FileReq = AllocAslRequestTags(ASL_FileRequest, TAG_DONE)))
  94.     {
  95.         u_short flags = 0;
  96.         u_char *dircopy;
  97.         if(!NILP(writep))
  98.         flags |= FILF_SAVE;
  99.         if(dircopy = mystrdup(VSTR(filename)))
  100.         {
  101.         u_char *actualfile = FilePart(VSTR(filename));
  102.         dircopy[actualfile - VSTR(filename)] = 0;
  103.         if(AslRequestTags(FileReq,
  104.             ASL_Hail, VSTR(title),
  105.             ASL_Window, CurrVW->vw_Window,
  106.             ASL_File, actualfile,
  107.             ASL_Dir, dircopy,
  108.             ASL_FuncFlags, flags,
  109.             TAG_END))
  110.         {
  111.             long sellen = strlen(FileReq->rf_File) + strlen(FileReq->rf_Dir) + 2;
  112.             if(result = valstralloc(sellen))
  113.             {
  114.             strcpy(VSTR(result), FileReq->rf_Dir);
  115.             AddPart(VSTR(result), FileReq->rf_File, sellen);
  116.             }
  117.             else
  118.             settitle(NoMemMsg);
  119.         }
  120.         mystrfree(dircopy);
  121.         }
  122.         else
  123.         settitle(NoMemMsg);
  124.     }
  125.     else
  126.         cmd_signal(sym_error, LIST_1(MKSTR("Can't allocate file requester")));
  127.     }
  128.     else
  129.     cmd_signal(sym_error, LIST_1(MKSTR("Need `asl.library'")));
  130.     return(result);
  131. }
  132.  
  133. void
  134. beep(VW *vw)
  135. {
  136.     DisplayBeep(vw->vw_Window->WScreen);
  137. }
  138.  
  139. bool
  140. samefiles(u_char *file1, u_char *file2)
  141. {
  142.     bool rc = FALSE;
  143.     BPTR lck1;
  144.     if(lck1 = Lock(file1, SHARED_LOCK))
  145.     {
  146.     BPTR lck2;
  147.     if(lck2 = Lock(file2, SHARED_LOCK))
  148.     {
  149.         if(SameLock(lck1, lck2) == LOCK_SAME)
  150.         rc = TRUE;
  151.         UnLock(lck2);
  152.     }
  153.     UnLock(lck1);
  154.     }
  155.     else
  156.     rc = !stricmp(file1, file2);
  157.     return(rc);
  158. }
  159.  
  160. u_char *
  161. filepart(u_char *file)
  162. {
  163.     return(FilePart(file));
  164. }
  165.  
  166. #ifdef _DCC
  167. void
  168. NewList(struct List *list)
  169. {
  170.     list->lh_Head = (struct Node *)&list->lh_Tail;
  171.     list->lh_Tail = NULL;
  172.     list->lh_TailPred = (struct Node *)&list->lh_Head;
  173. }
  174. #endif
  175.  
  176. VALUE
  177. geterrstring(void)
  178. {
  179.     u_char buf[256];
  180.     if(!Fault(IoErr(), "", buf, 256))
  181.     sprintf(buf, "%d", IoErr());
  182.     return(valstrdup(buf));
  183. }
  184.  
  185. void
  186. doconmsg(u_char *msg)
  187. {
  188.     /*
  189.      * CLI/WB & 1.3/2.0 compatible
  190.      */
  191.     if(FromWB)
  192.     {
  193.     BPTR fh = Open("CON:///80/Jade output/WAIT/CLOSE", MODE_NEWFILE);
  194.     if(fh)
  195.         Write(fh, msg, strlen(msg));
  196.     Close(fh);
  197.     }
  198.     else
  199.     Write(Output(), msg, strlen(msg));
  200. }
  201.  
  202. u_char *
  203. squirrelfile(u_char *fileName)
  204. {
  205.     BPTR fh = Open(fileName, MODE_OLDFILE);
  206.     if(fh)
  207.     {
  208.     long length;
  209.     u_char *mem;
  210.     Seek(fh, 0, OFFSET_END);
  211.     length = Seek(fh, 0, OFFSET_BEGINNING);
  212.     if(mem = mystralloc(length + 1))
  213.     {
  214.         Read(fh, mem, length);
  215.         mem[length] = 0;
  216.         Close(fh);
  217.         return(mem);
  218.     }
  219.     else
  220.         settitle(NoMemMsg);
  221.     Close(fh);
  222.     }
  223.     return(FALSE);
  224. }
  225.  
  226. VALUE
  227. valsquirrelfile(u_char *fileName)
  228. {
  229.     BPTR fh = Open(fileName, MODE_OLDFILE);
  230.     if(fh)
  231.     {
  232.     long length;
  233.     VALUE mem;
  234.     Seek(fh, 0, OFFSET_END);
  235.     length = Seek(fh, 0, OFFSET_BEGINNING);
  236.     if(mem = valstralloc(length + 1))
  237.     {
  238.         Read(fh, VSTR(mem), length);
  239.         VSTR(mem)[length] = 0;
  240.         Close(fh);
  241.         return(mem);
  242.     }
  243.     else
  244.         settitle(NoMemMsg);
  245.     Close(fh);
  246.     }
  247.     return(cmd_signal(sym_file_error, list_2(geterrstring(), valstrdup(fileName))));
  248. }
  249.  
  250. int
  251. addfilepart(u_char *buf, u_char *part, int len)
  252. {
  253.     return(AddPart(buf, part, len));
  254. }
  255.  
  256. long
  257. getfibfield(u_char *file, int field)
  258. {
  259.     long rc = 0;
  260.     BPTR lock;
  261.     if(lock = Lock(file, SHARED_LOCK))
  262.     {
  263.     struct FileInfoBlock *fib;
  264.     if(fib = mymalloc(sizeof(struct FileInfoBlock)))
  265.     {
  266.         if(Examine(lock, fib))
  267.         rc = *(LONG *)((char *)fib + field);
  268.         myfree(fib);
  269.     }
  270.     UnLock(lock);
  271.     }
  272.     return(rc);
  273. }
  274.  
  275. _PR VALUE cmd_flush_output(void);
  276. DEFUN("flush-output", cmd_flush_output, subr_flush_output, (void), V_Subr0, DOC_flush_output)
  277. {
  278.     return(sym_t);
  279. }
  280.  
  281. _PR VALUE cmd_delete_file(VALUE file);
  282. DEFUN("delete-file", cmd_delete_file, subr_delete_file, (VALUE file), V_Subr1, DOC_delete_file)
  283. {
  284.     DECLARE1(file, STRINGP);
  285.     if(DeleteFile(VSTR(file)))
  286.     return(sym_t);
  287.     return(cmd_signal(sym_file_error, list_2(geterrstring(), file)));
  288. }
  289.  
  290. _PR VALUE cmd_rename_file(VALUE src, VALUE dst);
  291. DEFUN("rename-file", cmd_rename_file, subr_rename_file, (VALUE src, VALUE dst), V_Subr2, DOC_rename_file)
  292. {
  293.     DECLARE1(src, STRINGP);
  294.     DECLARE2(dst, STRINGP);
  295.     if(Rename(VSTR(src), VSTR(dst)))
  296.     return(sym_t);
  297.     return(cmd_signal(sym_file_error, list_3(geterrstring(), src, dst)));
  298. }
  299.  
  300. _PR VALUE cmd_copy_file(VALUE src, VALUE dst);
  301. DEFUN("copy-file", cmd_copy_file, subr_copy_file, (VALUE src, VALUE dst), V_Subr2, DOC_copy_file)
  302. {
  303.     VALUE res = sym_t;
  304.     BPTR srcf;
  305.     DECLARE1(src, STRINGP);
  306.     DECLARE2(dst, STRINGP);
  307.     srcf = Open(VSTR(src), MODE_OLDFILE);
  308.     if(srcf != NULL)
  309.     {
  310.     int dstf = Open(VSTR(dst), MODE_NEWFILE);
  311.     if(dstf != NULL)
  312.     {
  313.         int rd;
  314.         int prot = getfibfield(VSTR(src), (int)OFFSET(FileInfoBlock, fib_Protection));
  315.         if(prot != 0)
  316.         SetProtection(VSTR(dst), prot &~ FIBF_ARCHIVE);
  317.         do {
  318.         u_char buf[BUFSIZ];
  319.         int wr;
  320.         rd = Read(srcf, buf, BUFSIZ);
  321.         if(rd < 0)
  322.         {
  323.             res = signalfileerror(src);
  324.             break;
  325.         }
  326.         wr = Write(dstf, buf, rd);
  327.         if(wr != rd)
  328.         {
  329.             res = signalfileerror(dst);
  330.             break;
  331.         }
  332.         } while(rd != 0);
  333.         Close(dstf);
  334.     }
  335.     else
  336.         res = signalfileerror(dst);
  337.     Close(srcf);
  338.     }
  339.     else
  340.     res = signalfileerror(src);
  341.     return(res);
  342. }
  343.  
  344. _PR VALUE cmd_file_readable_p(VALUE file);
  345. DEFUN("file-readable-p", cmd_file_readable_p, subr_file_readable_p, (VALUE file), V_Subr1, DOC_file_readable_p)
  346. {
  347.     int prot;
  348.     DECLARE1(file, STRINGP);
  349.     prot= getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_Protection));
  350.     if(~prot & FIBF_READ)
  351.     return(sym_t);
  352.     return(sym_nil);
  353. }
  354.  
  355. _PR VALUE cmd_file_writeable_p(VALUE file);
  356. DEFUN("file-writeable-p", cmd_file_writeable_p, subr_file_writeable_p, (VALUE file), V_Subr1, DOC_file_writeable_p)
  357. {
  358.     int prot;
  359.     DECLARE1(file, STRINGP);
  360.     prot = getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_Protection));
  361.     if(~prot & FIBF_WRITE)
  362.     return(sym_t);
  363.     return(sym_nil);
  364. }
  365.  
  366. _PR VALUE cmd_file_exists_p(VALUE file);
  367. DEFUN("file-exists-p", cmd_file_exists_p, subr_file_exists_p, (VALUE file), V_Subr1, DOC_file_exists_p)
  368. {
  369.     BPTR lock;
  370.     DECLARE1(file, STRINGP);
  371.     if(lock = Lock(VSTR(file), SHARED_LOCK))
  372.     {
  373.     UnLock(lock);
  374.     return(sym_t);
  375.     }
  376.     return(sym_nil);
  377. }
  378.  
  379. int
  380. fileexists(u_char *fileName)
  381. {
  382.     BPTR lock;
  383.     if(lock = Lock(fileName, SHARED_LOCK))
  384.     {
  385.     int type;
  386.     UnLock(lock);
  387.     type = getfibfield(fileName, (int)OFFSET(FileInfoBlock, fib_DirEntryType));
  388.     /* Only allow _files_ */
  389.     if(type < 0)
  390.         return(TRUE);
  391.     }
  392.     return(FALSE);
  393. }
  394.  
  395. _PR VALUE cmd_file_regular_p(VALUE file);
  396. DEFUN("file-regular-p", cmd_file_regular_p, subr_file_regular_p, (VALUE file), V_Subr1, DOC_file_regular_p)
  397. {
  398.     int type;
  399.     DECLARE1(file, STRINGP);
  400.     if(type = getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_DirEntryType)))
  401.     {
  402.     if(type < 0)
  403.         return(sym_t);
  404.     }
  405.     return(sym_nil);
  406. }
  407.  
  408. _PR VALUE cmd_file_directory_p(VALUE file);
  409. DEFUN("file-directory-p", cmd_file_directory_p, subr_file_directory_p, (VALUE file), V_Subr1, DOC_file_directory_p)
  410. {
  411.     int type;
  412.     DECLARE1(file, STRINGP);
  413.     if(type = getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_DirEntryType)))
  414.     {
  415.     /* There may be a problem here, ST_SOFTLINK>0 so, these will make
  416.        this function return t.  */
  417.     if(type > 0)
  418.         return(sym_t);
  419.     }
  420.     return(sym_nil);
  421. }
  422.  
  423. _PR VALUE cmd_file_symlink_p(VALUE file);
  424. DEFUN("file-symlink-p", cmd_file_symlink_p, subr_file_symlink_p, (VALUE file), V_Subr1, DOC_file_symlink_p)
  425. {
  426.     int type;
  427.     DECLARE1(file, STRINGP);
  428.     if(type = getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_DirEntryType)))
  429.     {
  430.     if(type == ST_SOFTLINK)
  431.         return(sym_t);
  432.     }
  433.     return(sym_nil);
  434. }
  435.  
  436. _PR VALUE cmd_file_owner_p(VALUE file);
  437. DEFUN("file-owner-p", cmd_file_owner_p, subr_file_owner_p, (VALUE file), V_Subr1, DOC_file_owner_p)
  438. {
  439.     return(sym_t);
  440. }
  441.  
  442. _PR VALUE cmd_file_nlinks(VALUE file);
  443. DEFUN("file-nlinks", cmd_file_nlinks, subr_file_nlinks, (VALUE file), V_Subr1, DOC_file_nlinks)
  444. {
  445.     /* I don't know how to do this in AmigaDOS -- is it possible? */
  446.     return(newnumber(1));
  447. }
  448.  
  449. _PR VALUE cmd_file_modes(VALUE file);
  450. DEFUN("file-modes", cmd_file_modes, subr_file_modes, (VALUE file), V_Subr1, DOC_file_modes)
  451. {
  452.     DECLARE1(file, STRINGP);
  453.     int bits = getfibfield(VSTR(file), (int)OFFSET(FileInfoBlock, fib_Protection));
  454.     if(bits != 0)
  455.     return(newnumber(bits));
  456.     return(sym_nil);
  457. }
  458.  
  459. _PR VALUE cmd_set_file_modes(VALUE file, VALUE modes);
  460. DEFUN("set-file-modes", cmd_set_file_modes, subr_set_file_modes, (VALUE file, VALUE modes), V_Subr2, DOC_set_file_modes)
  461. {
  462.     DECLARE1(file, STRINGP);
  463.     DECLARE2(modes, NUMBERP);
  464.     if(SetProtection(VSTR(file), VNUM(modes) & ~FIBF_ARCHIVE))
  465.     return(sym_t);
  466.     return(signalfileerror(file));
  467. }
  468.  
  469. static long
  470. dstotime(struct DateStamp *ds)
  471. {
  472.     return((ds->ds_Days * 86400) + (ds->ds_Minute * 60) + (ds->ds_Tick / TICKS_PER_SECOND));
  473. }
  474.  
  475. long
  476. filemodtime(u_char *fileName)
  477. {
  478.     long time = 0;
  479.     BPTR lock;
  480.     if(lock = Lock(fileName, SHARED_LOCK))
  481.     {
  482.     struct FileInfoBlock *fib;
  483.     if(fib = mymalloc(sizeof(struct FileInfoBlock)))
  484.     {
  485.         if(Examine(lock, fib))
  486.         time = dstotime(&fib->fib_Date);
  487.         myfree(fib);
  488.     }
  489.     UnLock(lock);
  490.     }
  491.     return(time);
  492. }
  493.  
  494. long
  495. getsystime(void)
  496. {
  497.     struct DateStamp ds;
  498.     DateStamp(&ds);
  499.     return(dstotime(&ds));
  500. }
  501.  
  502. _PR VALUE cmd_file_modtime(VALUE file);
  503. DEFUN("file-modtime", cmd_file_modtime, subr_file_modtime, (VALUE file), V_Subr1, DOC_file_modtime)
  504. {
  505.     DECLARE1(file, STRINGP);
  506.     return(newnumber(filemodtime(VSTR(file))));
  507. }
  508.  
  509. _PR VALUE cmd_directory_files(VALUE dir);
  510. DEFUN("directory-files", cmd_directory_files, subr_directory_files, (VALUE dir), V_Subr1, DOC_directory_files)
  511. {
  512.     BPTR dirlock;
  513.     DECLARE1(dir, STRINGP);
  514.     if(dirlock = Lock(VSTR(dir), SHARED_LOCK))
  515.     {
  516.     VALUE list = sym_nil;
  517.     struct FileInfoBlock *fib;
  518.     if(fib = mymalloc(sizeof(struct FileInfoBlock)))
  519.     {
  520.         if(Examine(dirlock, fib))
  521.         {
  522.         while(ExNext(dirlock, fib))
  523.         {
  524.             VALUE name;
  525.             if(!((name = valstrdup(fib->fib_FileName)) && (list = cmd_cons(name, list))))
  526.             {
  527.             settitle(NoMemMsg);
  528.             myfree(fib);
  529.             UnLock(dirlock);
  530.             return(NULL);
  531.             }
  532.         }
  533.         }
  534.         myfree(fib);
  535.     }
  536.     UnLock(dirlock);
  537.     return(list);
  538.     }
  539.     return(cmd_signal(sym_file_error, list_2(geterrstring(), dir)));
  540. }
  541.  
  542. _PR VALUE cmd_user_login_name(void);
  543. DEFUN("user-login-name", cmd_user_login_name, subr_user_login_name, (void), V_Subr0, DOC_user_login_name)
  544. {
  545.     char *name;
  546.     /* Just look this up once, then use the saved copy.  */
  547.     static VALUE user_login_name;
  548.     if(user_login_name)
  549.     return(user_login_name);
  550.     name = getenv("USERNAME");
  551.     if(name)
  552.     user_login_name = valstrdup(name);
  553.     else
  554.     user_login_name = MKSTR("<unknown username>");
  555.     markstatic(&user_login_name);
  556.     return(user_login_name);
  557. }
  558.  
  559. _PR VALUE cmd_user_full_name(void);
  560. DEFUN("user-full-name", cmd_user_full_name, subr_user_full_name, (void), V_Subr0, DOC_user_full_name)
  561. {
  562.     char *name;
  563.     static VALUE user_full_name;
  564.     if(user_full_name)
  565.     return(user_full_name);
  566.     name = getenv("REALNAME");
  567.     if(name)
  568.     user_full_name = valstrdup(name);
  569.     else
  570.     user_full_name = MKSTR("<unknown full name>");
  571.     markstatic(&user_full_name);
  572.     return(user_full_name);
  573. }
  574.  
  575. _PR VALUE cmd_user_home_directory(void);
  576. DEFUN("user-home-directory", cmd_user_home_directory, subr_user_home_directory, (void), V_Subr0, DOC_user_home_directory)
  577. {
  578.     char *home;
  579.     static VALUE user_home_directory;
  580.     if(user_home_directory)
  581.     return(user_home_directory);
  582.     home = getenv("HOME");
  583.     if(home)
  584.     user_home_directory = valstrdup(home);
  585.     else
  586.     user_home_directory = MKSTR("SYS:");
  587.     markstatic(&user_home_directory);
  588.     return(user_home_directory);
  589. }
  590.  
  591. _PR VALUE cmd_system_name(void);
  592. DEFUN("system-name", cmd_system_name, subr_system_name, (void), V_Subr0,  DOC_system_name)
  593. {
  594.     char *name;
  595.     static VALUE system_name;
  596.     if(system_name)
  597.     return(system_name);
  598.     name = getenv("HOSTNAME");
  599.     if(name)
  600.     system_name = valstrdup(name);
  601.     else
  602.     system_name = MKSTR("<unknown system name>");
  603.     markstatic(&system_name);
  604.     return(system_name);
  605. }
  606.  
  607. void
  608. sys_misc_init(void)
  609. {
  610.     ADD_SUBR(subr_file_req);
  611.     ADD_SUBR(subr_flush_output);
  612.     ADD_SUBR(subr_delete_file);
  613.     ADD_SUBR(subr_rename_file);
  614.     ADD_SUBR(subr_copy_file);
  615.     ADD_SUBR(subr_file_readable_p);
  616.     ADD_SUBR(subr_file_writeable_p);
  617.     ADD_SUBR(subr_file_exists_p);
  618.     ADD_SUBR(subr_file_regular_p);
  619.     ADD_SUBR(subr_file_directory_p);
  620.     ADD_SUBR(subr_file_symlink_p);
  621.     ADD_SUBR(subr_file_owner_p);
  622.     ADD_SUBR(subr_file_nlinks);
  623.     ADD_SUBR(subr_file_modes);
  624.     ADD_SUBR(subr_set_file_modes);
  625.     ADD_SUBR(subr_file_modtime);
  626.     ADD_SUBR(subr_directory_files);
  627.     ADD_SUBR(subr_user_login_name);
  628.     ADD_SUBR(subr_user_full_name);
  629.     ADD_SUBR(subr_user_home_directory);
  630.     ADD_SUBR(subr_system_name);
  631. }
  632.