Add error message if unimplemented subroutines are used (#628)

Author: kio-watanabe

cobj/tree.h

@@ -222,6 +222,56 @@ enum cb_usage {
 
 enum cb_operand_type { CB_SENDING_OPERAND, CB_RECEIVING_OPERAND };
 
+enum cb_system_routine {
+  SYSTEM,
+  CBL_AND,
+  CBL_CHANGE_DIR,
+  CBL_CHECK_FILE_EXIST,
+  CBL_CLOSE_FILE,
+  CBL_COPY_FILE,
+  CBL_CREATE_DIR,
+  CBL_CREATE_FILE,
+  CBL_DELETE_DIR,
+  CBL_DELETE_FILE,
+  CBL_EQ,
+  CBL_ERROR_PROC,
+  CBL_EXIT_PROC,
+  CBL_FLUSH_FILE,
+  CBL_GET_CURRENT_DIR,
+  CBL_IMP,
+  CBL_NIMP,
+  CBL_NOR,
+  CBL_NOT,
+  CBL_OC_NANOSLEEP,
+  CBL_OPEN_FILE,
+  CBL_OR,
+  CBL_READ_FILE,
+  CBL_RENAME_FILE,
+  CBL_TOLOWER,
+  CBL_TOUPPER,
+  CBL_WRITE_FILE,
+  CBL_XOR,
+  CBL_OC_KEISEN,
+  CBL_OC_ATTRIBUTE,
+  C$CHDIR,
+  C$COPY,
+  C$DELETE,
+  C$FILEINFO,
+  C$LIST_DIRECTORY,
+  C$GETPID,
+  C$JUSTIFY,
+  C$CALLEDBY,
+  C$MAKEDIR,
+  C$NARG,
+  C$SLEEP,
+  C$PARAMSIZE,
+  C$TOUPPER,
+  C$TOLOWER,
+  CBL_X91,
+  CBL_XF4,
+  CBL_XF5
+};
+
 /*
  * Tree
  */

cobj/typeck.c

@@ -3099,13 +3099,48 @@ void cb_emit_call(cb_tree prog, cb_tree cb_using, cb_tree returning,
     const struct system_table *psyst;
     for (psyst = (const struct system_table *)&system_tab[0]; psyst->syst_name;
          psyst++) {
-      if (!strcmp((const char *)CB_LITERAL(prog)->data,
-                  (const char *)psyst->syst_name)) {
+      const char *data = (const char *)CB_LITERAL(prog)->data;
+      if (!strcmp(data, (const char *)psyst->syst_name)) {
+        // error if the subroutine is not implemented
+        switch (psyst - &system_tab[0]) {
+        case CBL_CHANGE_DIR:
+        case CBL_CHECK_FILE_EXIST:
+        case CBL_CLOSE_FILE:
+        case CBL_COPY_FILE:
+        case CBL_CREATE_DIR:
+        case CBL_CREATE_FILE:
+        case CBL_DELETE_DIR:
+        case CBL_DELETE_FILE:
+        case CBL_ERROR_PROC:
+        case CBL_EXIT_PROC:
+        case CBL_FLUSH_FILE:
+        case CBL_GET_CURRENT_DIR:
+        case CBL_IMP:
+        case CBL_OPEN_FILE:
+        case CBL_READ_FILE:
+        case CBL_RENAME_FILE:
+        case CBL_WRITE_FILE:
+        case CBL_OC_KEISEN:
+        case CBL_OC_ATTRIBUTE:
+        case C$CHDIR:
+        case C$COPY:
+        case C$DELETE:
+        case C$FILEINFO:
+        case C$GETPID:
+        case C$JUSTIFY:
+        case C$MAKEDIR:
+        case C$NARG:
+        case C$SLEEP:
+        case C$PARAMSIZE:
+          cb_error(_("%s not implemented"), data);
+          return;
+        }
         if (psyst->syst_params > cb_list_length(cb_using)) {
           cb_error(_("Wrong number of CALL parameters for '%s'"),
                    (char *)psyst->syst_name);
           return;
         }
+
         is_sys_call = 1;
         break;
       }