home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / DEBUG.ZIP / DEBUGIFY.IC0 < prev    next >
Encoding:
Text File  |  1992-11-20  |  19.3 KB  |  569 lines
  1. ############################################################################
  2. #
  3. #    File:     debugify.ic0 / debugify.icn
  4. #
  5. #    Subject:  Create a ucode file with hooks to __debug_proc
  6. #
  7. #    Author:   Charles A. Shartsis
  8. #
  9. #    Date:     December 29, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.01
  14. #
  15. ###########################################################################
  16. #
  17. # See documentation in DEBUGIFY.DOC
  18. #
  19. ############################################################################
  20.  
  21. link radcon
  22.  
  23. global ws, nonws, label_prefix, labelno, high_labels, tmpname, builtin_tab
  24. global line, curproc, lineno, fname, symbol_id, symbol_type, symbol_name
  25. global con_id, con_type, first_filename, debug_proc_name, debug_proc_id
  26. global next_symbol_id, last_symbol_id, name_list_name, val_list_name
  27. global put_id, variable_id, name_list_id, val_list_id
  28. global last_con_id, next_con_id, proc_symbols, save_label, index_id, one_id
  29. global index_name, tmpfile, cur_sym_name, symbol_list, proc_name_id
  30. global modify, includes, include_procs, infile_name, infile
  31. global andfileid, andlineid, version
  32.     
  33.  
  34. # Add __debug var or nodebug var & inhibit branch
  35. # DEBUGIFY SEQ
  36. procedure main(argv)
  37.  
  38.     # DO NOT MODIFY, MOVE, OR DELETE THIS COMMENT LINE
  39.     (\andfileid & \andlineid & \version) | stop(&errout, "Debugify not configured.")
  40.     write(&errout, "Debugify running: Configured for Icon Version ", version)
  41.  
  42.     # Process command line options
  43.     modify := &null
  44.     includes := &null
  45.     include_procs := table(&null)
  46.     infile_name := "-"
  47.     process_options(argv)
  48.     if infile_name == "-" then {
  49.         infile := &input
  50.     }
  51.     else {
  52.         (infile := open(infile_name, "r")) | stop(&errout, "Cannot open input file ", infile_name)
  53.     }
  54.  
  55.     ws := ' \t'
  56.     nonws := &ascii -- ws
  57.     debug_proc_name := "__debug_proc"
  58.     name_list_name := "__names"
  59.     val_list_name := "__vals"
  60.     label_prefix := "L"
  61.     index_name := "__i"
  62.     high_labels := table(0)
  63.     tmpname := "debugify.tmp"
  64.     do_builtins()
  65.     
  66.     # Get high labels for each proc
  67.     get_high_labels()
  68.     
  69.     (tmpfile := open(tmpname, "r")) | stop(&errout, "Cannot open ", tmpname,"  for input")
  70.     
  71.     line := (read(tmpfile) | &null)
  72.     
  73.     # BODY ITR UNTIL EOF
  74.     until /line do {
  75.     
  76.         # PROC SEQ
  77.         curproc := &null
  78.         line ? {
  79.             cstar(ws) & ="proc" & cplus(ws) &
  80.             (curproc <- tab(many(nonws))) &
  81.             cstar(ws) & pos(0)
  82.         }
  83.         \curproc | stop(&errout, "invalid proc line:",line)
  84.  
  85.         # Reset proc values
  86.         last_symbol_id := 0
  87.         last_con_id := 0
  88.         labelno := high_labels[curproc]
  89.         proc_symbols := table(&null)
  90.         symbol_list := []
  91.         
  92.         write(line)
  93.         
  94.         line := (read(tmpfile) | &null)
  95.         
  96.         
  97.             # SYMBOLS ITR UNTIL END OF LOCAL LIST
  98.             until not (line ? (cstar(ws) & ="local")) do {
  99.             
  100.                 # SYMBOL SEQ
  101.                 
  102.                     symbol_id := &null
  103.                     symbol_type := &null
  104.                     symbol_name := &null
  105.                     line ? {
  106.                         cstar(ws) & ="local" & cplus(ws) &
  107.                         symbol_id <- integer(tab(many(&digits))) & 
  108.                         cstar(ws) & ="," & cstar(ws) &
  109.                         symbol_type <- tab(many(&digits)) & 
  110.                         cstar(ws) & ="," & cstar(ws) &
  111.                         symbol_name <- tab(many(nonws)) &
  112.                         cstar(ws) & pos(0)
  113.                     }
  114.                     \symbol_id | stop(&errout, "invalid symbol line:",line)
  115.                     
  116.                     
  117.                     last_symbol_id := symbol_id
  118.                     if /(builtin_tab[symbol_name]) then proc_symbols[symbol_name] := 1
  119.                     
  120.                     write(line)
  121.                 
  122.                     line := (read(tmpfile) | &null)
  123.                     
  124.                 # SYMBOL END
  125.                 
  126.             # SYMBOLS END
  127.             }
  128.             
  129.             # Install new symbols
  130.             
  131.             if curproc ~== debug_proc_name then {
  132.             
  133.                 next_symbol_id := last_symbol_id + 1
  134.                 write("\tlocal\t", next_symbol_id, ",000000,", debug_proc_name)
  135.                 debug_proc_id := next_symbol_id
  136.             
  137.                 next_symbol_id +:= 1
  138.                 write("\tlocal\t", next_symbol_id, ",000000,put")
  139.                 put_id := next_symbol_id
  140.             
  141.                 next_symbol_id +:= 1
  142.                 write("\tlocal\t", next_symbol_id, ",000000,variable")
  143.                 variable_id := next_symbol_id
  144.             
  145.                 next_symbol_id +:= 1
  146.                 write("\tlocal\t", next_symbol_id, ",000020,", name_list_name)
  147.                 name_list_id := next_symbol_id
  148.             
  149.                 next_symbol_id +:= 1
  150.                 write("\tlocal\t", next_symbol_id, ",000020,", val_list_name)
  151.                 val_list_id := next_symbol_id
  152.             
  153.                 next_symbol_id +:= 1
  154.                 write("\tlocal\t", next_symbol_id, ",000020,", index_name)
  155.                 index_id := next_symbol_id
  156.             
  157.                 next_symbol_id +:= 1
  158.                 
  159.             }
  160.     
  161.             
  162.             # CONSTANTS ITR UNTIL END OF CONSTANT LIST
  163.             until not (line ? (cstar(ws) & ="con")) do {
  164.             
  165.                 #CONSTANT SEQ
  166.                                
  167.                     con_id := &null
  168.                     con_type := &null
  169.                     line ? {
  170.                         cstar(ws) & ="con" & cplus(ws) &
  171.                         con_id <- integer(tab(many(&digits))) & 
  172.                         cstar(ws) & ="," & cstar(ws) &
  173.                         con_type <- tab(many(&digits))
  174.                     }
  175.                     (\con_id) | stop(&errout, "invalid constant line:",line)
  176.                 
  177.                     last_con_id := con_id
  178.                     
  179.                     write(line)
  180.                 
  181.                     line := (read(tmpfile) | &null)
  182.                     
  183.                 #CONSTANT END
  184.                 
  185.                 
  186.             # CONSTANTS END
  187.             }
  188.             
  189.             # Install new string constants for the names of all the 
  190.             # previously existing symbols
  191.             # When finished, proc_symbols will map names of previously
  192.             # existing symbols to their unique constant identifier
  193.             
  194.             if curproc ~== debug_proc_name then {
  195.             
  196.                 next_con_id := last_con_id + 1
  197.  
  198.                 every cur_sym_name := key(proc_symbols) do {
  199.                     writes("\tcon\t", next_con_id, ",010000,", *cur_sym_name)
  200.                     octal_list(cur_sym_name)
  201.                     write("")
  202.                     proc_symbols[cur_sym_name] := next_con_id
  203.                     next_con_id +:= 1
  204.                 }
  205.                 
  206.                 # Install other new constants
  207.                 
  208.                 # The constant 1
  209.                 write("\tcon\t", next_con_id, ",002000,1,1")
  210.                 one_id := next_con_id
  211.                 
  212.                 next_con_id +:= 1
  213.             
  214.                 # The procedure name constant
  215.                 writes("\tcon\t", next_con_id, ",010000,", *curproc)
  216.                 octal_list(curproc)
  217.                 write("")
  218.                 proc_name_id := next_con_id
  219.                 
  220.                 next_con_id +:= 1
  221.             
  222.             }
  223.             
  224.             # DECLEND SEQ
  225.             
  226.                 (line ? (cstar(ws) & ="declend" & cstar(ws) & pos(0))) |
  227.                     stop(&errout, "End Declaration Line not found where expected: ",line)
  228.             
  229.                 write(line)
  230.                         
  231.                 line := (read(tmpfile) | &null)
  232.                         
  233.             # DECLEND END
  234.             
  235.             # FILENAME SEQ
  236.             # The first procedure contains a file name line after the declarations
  237.             
  238.                 if /first_filename then {
  239.                 
  240.                     first_filename := 1
  241.             
  242.                     fname := &null
  243.                     line ? {
  244.                        cstar(ws) & ="filen" & cplus(ws) &
  245.                        (fname <- cplus(nonws)) &
  246.                       cstar(ws) & pos(0)
  247.                     }
  248.                 
  249.                     \fname | stop(&errout, "file name not properly parsed")
  250.                     write(line)
  251.                         
  252.                     line := (read(tmpfile) | &null)
  253.                     
  254.                 }
  255.                         
  256.             # FILENAME END
  257.  
  258.             # Install __names := [ s1, s2, ... ]
  259.             # where s1, s2, ... are the names of previously existing symbols
  260.             if curproc ~== debug_proc_name then {
  261.                 save_label := next_label()
  262.                 write("\tmark\t",save_label)
  263.                 write("\tpnull")
  264.                 write("\tvar\t",name_list_id)
  265.                 write("\tpnull")
  266.                 every write("\tstr\t", (!sort(proc_symbols))[2])
  267.                 write("\tllist\t", *proc_symbols)
  268.                 write("\tasgn")
  269.                 write("\tunmark")
  270.                 write("lab ", save_label)
  271.             }
  272.             
  273.             
  274.             # SOURCE_LINES ITR UNTIL EOF OR END OF PROC
  275.             until (
  276.                 /line |
  277.                 (line ? (cstar(ws) & ="proc" & cplus(ws)))
  278.             ) do {
  279.             
  280.                 # SOURCE_LINE SEQ
  281.                 
  282.                     # LINE_NUMBER SEQ
  283.                     
  284.                     line_number()
  285.                   
  286.                     # LINE_NUMBER END
  287.                     
  288.                     # LINE_BODY ITR UNTIL EOF OR END OF SOURCE LINE
  289.                     
  290.                     line_body()
  291.                         
  292.                     # LINE_BODY END
  293.                     
  294.                 # SOURCE_LINE END
  295.                 
  296.             # SOURCE_LINES END
  297.             }
  298.             
  299.         # PROC END
  300.     
  301.     # BODY END
  302.     }
  303.     
  304.     close(tmpfile)
  305.     remove(tmpname) | stop(&errout, "Unable to delete ", tmpname)
  306.     
  307. # DEBUGIFY END
  308. end
  309.  
  310. procedure cstar(c)
  311.     suspend "" | tab(many(c))
  312. end
  313.  
  314. procedure cplus(c)
  315.     return tab(many(c))
  316. end
  317.  
  318. # Print a string as a list of octal numbers, each preceded by a comma
  319. procedure octal_list(s)
  320.  
  321.     every writes(",",exbase10(ord(!s),8))
  322.     
  323. end
  324.  
  325. procedure next_label()
  326.  
  327.     labelno +:= 1
  328.  
  329.     return label_prefix || labelno
  330.  
  331. end
  332.  
  333. procedure get_high_labels()
  334.  
  335.     local line, labelno, curproc, tmpfile
  336.     
  337.     (tmpfile := open(tmpname,"w")) | stop(&errout, "Unable to open ", tmpname, " for output")
  338.     
  339.     line := (read(infile) | &null)
  340.  
  341.     until /line do {
  342.     
  343.         line ? (
  344.             cstar(ws) & ="proc" & cplus(ws) & 
  345.             curproc <- tab(many(nonws)) & 
  346.             cstar(ws) & pos(0)
  347.         )
  348.     
  349.         labelno := &null
  350.         if line ? (
  351.             ="lab L" & 
  352.             (labelno <- integer(tab(many(&digits)))) &
  353.             cstar(ws) & pos(0)
  354.         ) then {
  355.         
  356.             if labelno > high_labels[curproc] then      
  357.                 high_labels[curproc] := labelno
  358.         }
  359.         
  360.         write(tmpfile, line)        
  361.     
  362.         line := (read(infile) | &null)
  363.         
  364.     }
  365.     
  366.     close(tmpfile)
  367.     
  368. end
  369.  
  370. procedure do_builtins()
  371.  
  372.     local builtin
  373.  
  374.     builtin_tab := table(&null)
  375.     builtin :=
  376.         [ "abs", "any", "args", "bal", "center", "char", "close", "collect", 
  377.         "copy", "cset", "delete", "detab", "display", "entab", "errorclear", 
  378.         "exit", "find", "get", "getenv", "iand", "icom", "image", "insert", 
  379.         "integer", "ior", "ishift", "ixor", "key", "left", "list", "many", 
  380.         "map", "match", "member", "move", "name", "numeric", "open", "ord", 
  381.         "pop", "pos", "proc", "pull", "push", "put", "read", "reads", "real", 
  382.         "remove", "rename", "repl", "reverse", "right", "runerr", "seek", "seq", 
  383.         "set", "sort", "stop", "string", "tab", "table", "trim", "type", "upto", 
  384.         "variable", "where", "write", "writes", "system", "callout", "acos", 
  385.         "asin", "atan", "cos", "tor", "exp", "log", "rtod", "sin", "sqrt", 
  386.         "tan", "getch", "getche", "kbhit", "IntPeek", "Poke", "GetSpace", 
  387.         "FreeSpace", "InPort", "OutPort", "mmout", "mmpause", "mmshow" ]
  388.     every builtin_tab[!builtin] := 1
  389.     
  390. end
  391.  
  392. procedure line_number()
  393.  
  394.                     # LINE_NUMBER SEQ
  395.                     
  396.                         lineno := &null
  397.                         line ? {
  398.                             cstar(ws) & ="line" & cplus(ws) &
  399.                             (lineno <- integer(tab(many(&digits)))) &
  400.                             cstar(ws) & pos(0)
  401.                         }
  402.                         \lineno | stop(&errout, "Invalid Source Line Number Line: ", line)
  403.                     
  404.                         write(line)
  405.                         
  406.                         if not (
  407.                             curproc == debug_proc_name |
  408.                             (
  409.                                 \includes & /include_procs[curproc]
  410.                             )
  411.                         ) then {
  412.                         
  413.                             # Install __vals := []
  414.                             write("\tmark\t", save_label := next_label())
  415.                             write("\tpnull")
  416.                             write("\tvar\t", val_list_id)
  417.                             write("\tpnull")
  418.                             write("\tllist\t0")
  419.                             write("\tasgn")
  420.                             write("\tunmark")
  421.                             write("lab ", save_label)
  422.                             
  423.                             # Install every put(_vals, variable(!__names))
  424.                             write("\tmark\t", save_label := next_label())
  425.                             write("\tmark0")
  426.                             write("\tvar\t", put_id)
  427.                             write("\tvar\t", val_list_id)
  428.                             write("\tvar\t", variable_id)
  429.                             write("\tpnull")
  430.                             write("\tvar\t", name_list_id)
  431.                             write("\tbang")
  432.                             write("\tinvoke\t1")
  433.                             write("\tinvoke\t2")
  434.                             write("\tpop")
  435.                             write("lab ",next_label())
  436.                             write("\tefail")
  437.                             write("lab ",next_label())
  438.                             write("\tunmark")
  439.                             write("lab ",save_label)
  440.  
  441.                             
  442.                             # Install __debug_proc(&file, <proc_name>, &line, __names, __vals)
  443.                             write("\tmark\t", save_label := next_label())
  444.                             write("\tvar\t", debug_proc_id)
  445.                             write("\tkeywd\t", andfileid)
  446.                             write("\tstr\t", proc_name_id)
  447.                             write("\tkeywd\t", andlineid)
  448.                             write("\tvar\t", name_list_id)
  449.                             write("\tvar\t", val_list_id)
  450.                             write("\tinvoke\t5")
  451.                             write("\tunmark")
  452.                             write("lab ",save_label)
  453.                             
  454.                             # Install
  455.                             #   every __i := 1 to *__names do
  456.                             #       variable(__names[__i]) := __vals[__i]
  457.                             if \modify then {
  458.                                 write("\tmark\t", save_label := next_label())
  459.                                 write("\tmark0")
  460.                                 write("\tpnull")
  461.                                 write("\tvar\t", index_id)
  462.                                 write("\tpnull")
  463.                                 write("\tint\t", one_id)
  464.                                 write("\tpnull")
  465.                                 write("\tvar\t", name_list_id)
  466.                                 write("\tsize")
  467.                                 write("\tpush1")
  468.                                 write("\ttoby")
  469.                                 write("\tasgn")
  470.                                 write("\tpop")
  471.                                 write("\tmark0")
  472.                                 write("\tpnull")
  473.                                 write("\tvar\t", variable_id)
  474.                                 write("\tpnull")
  475.                                 write("\tvar\t", name_list_id)
  476.                                 write("\tvar\t", index_id)
  477.                                 write("\tsubsc")
  478.                                 write("\tinvoke\t1")
  479.                                 write("\tpnull")
  480.                                 write("\tvar\t", val_list_id)
  481.                                 write("\tvar\t", index_id)
  482.                                 write("\tsubsc")
  483.                                 write("\tasgn")
  484.                                 write("\tunmark")
  485.                                 write("lab ", next_label())
  486.                                 write("\tefail")
  487.                                 write("lab ", next_label())
  488.                                 write("\tunmark")
  489.                                 write("lab ", save_label)
  490.                             }
  491.                                             
  492.                         }
  493.                         
  494.                         line := (read(tmpfile) | &null)
  495.  
  496.                     
  497.                     # LINE_NUMBER END
  498.  
  499. end
  500.  
  501. procedure line_body()
  502.  
  503.                     # LINE_BODY ITR UNTIL EOF OR END OF SOURCE LINE
  504.                     until (
  505.                         /line |
  506.                         ( line ? (cstar(ws) & ="proc" & cplus(ws)) ) |
  507.                         ( line ? (cstar(ws) & ="line" & cplus(ws)) )
  508.                     ) do {
  509.                     
  510.                         # OTHER_LINES SEQ
  511.                         
  512.                         write(line)
  513.                         
  514.                         line := (read(tmpfile) | &null)
  515.                         
  516.                         # OTHER_LINES END
  517.                         
  518.                     # LINE_BODY END
  519.                     }
  520.  
  521. end
  522.  
  523. procedure process_options(argv)
  524.  
  525.     local i, numfiles
  526.     
  527.     i := 1
  528.     numfiles := 0
  529.  
  530.     while i <= *argv do {
  531.     
  532.         case argv[i] of {
  533.         
  534.             "-i": {
  535.             
  536.                 includes := 1
  537.                 i +:= 1
  538.                 if i > *argv then stop(&errout, "Procedure name expected after -i option")
  539.                 include_procs[argv[i]] := 1
  540.                 
  541.             }
  542.         
  543.             "-m": {
  544.             
  545.                 modify := 1
  546.                 
  547.             }
  548.         
  549.             default: {
  550.             
  551.                 if (argv[i] ? ="-") & *argv[i] > 1 then stop(&errout, "Unknown option: ", argv[i])
  552.             
  553.                 infile_name := argv[i]
  554.                 numfiles +:= 1
  555.                 if numfiles > 1 then stop(&errout, "Only one input file name allowed on command line")
  556.             
  557.             }
  558.         
  559.         }
  560.         
  561.         i +:= 1
  562.         
  563.     }
  564.  
  565.  
  566. end
  567.  
  568.   
  569.