home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / snobol / vanilla.arc / CODE.SNO < prev    next >
Text File  |  1991-02-14  |  3KB  |  101 lines
  1. *    CODE.SNO
  2. *
  3. *    Program to allow entering test SNOBOL4 statements.
  4. *    Labels S and F are provided as convenient branch points.
  5. *    Function SLOAD is also included, to allow dynamically loading
  6. *    other SNOBOL4 functions.
  7. *
  8. *    Uses Units 15 and 16 for KEYBOARD and SLOAD.
  9. *
  10. *    User dialog is independent of INPUT and OUTPUT variables.  They
  11. *    are defaulted to CON:, but may be redirected from the DOS command
  12. *    line:
  13. *        A>SNOBOL4 CODE <INFILE >OUTFILE
  14. *
  15. *
  16. *    To avoid having to type the full line:
  17. *
  18. *    ?    SCREEN = <some expression>
  19. *
  20. *    CODE.SNO provides the following shorthand notations:
  21. *
  22. *    ?=expression
  23. *
  24. *    which internally expands to SCREEN = EVAL(expression)
  25. *
  26. *    (c) Copyright 1985, 1987 - Catspaw, Incorporated
  27.  
  28.     &TRIM = 1
  29.     SCREEN = 'Enter SNOBOL4 statements:'
  30.     INPUT('KEYBOARD', 15, 255, 'CON:')
  31.  
  32.     DEFINE('SLOAD(FILENAME)LIB,CODE,X,MAX_SAV,TRIM_SAV,POSITION')
  33.     WHITE_SPACE_    =    CHAR(9) ' '
  34.  
  35.     Q_        =    "'"
  36.     QQ_        =    '"'
  37.  
  38. *    Patterns to assist the SLOAD function.
  39.     SLOAD_STMT  =    ARBNO(Q_ BREAK(Q_) Q_ | QQ_ BREAK(QQ_) QQ_ |
  40. +              NOTANY(Q_ QQ_) BREAK(Q_ QQ_ ';')) ';'
  41.     SLOAD_STMTS =    FENCE (';' ARBNO(SLOAD_STMT)) . X '*' REM
  42.     SLOAD_CCPAT =    FENCE ('*' | '-' | RPOS(0))
  43.     SLOAD_CNPAT =    FENCE (';.' | ';+')
  44.  
  45. *    Trap and report conditionally fatal execution errors in user's code
  46.     &TRACE = 1000
  47.     &ERRLIMIT = 1000
  48.     DEFINE('ERRFUN_()')
  49.     TRACE('ERRTYPE','KEYWORD',,'ERRFUN_')
  50.  
  51. NEWLIN_ SCREEN = '?' CHAR(26)
  52.     INPT_  = KEYBOARD            :F(END)
  53.     INPT_ FENCE '=' REM . CODE        :S(EVAL_)
  54.  
  55. *    Compile statement with Goto appended and execute it
  56.     CODE   = CODE(INPT_ ' :S(S) F(F)')    :S<CODE>
  57.     SCREEN = 'Compilation error: ' &ERRTEXT ', reenter:' :(NEWLIN_)
  58.  
  59. S    SCREEN = 'Success'            :(NEWLIN_)
  60. F    SCREEN = 'Failure'            :(NEWLIN_)
  61. EVAL_    SCREEN = EVAL(CODE)            :S(S)F(F)
  62.  
  63. ERRFUN_    SCREEN = 'Execution error #' &ERRTYPE ', ' &ERRTEXT    :(RETURN)
  64.  
  65.  
  66. *    Function to read and compile SNOBOL4 functions from a disk file.
  67. *    The filename is specified as the argument to function SLOAD.
  68.  
  69. SLOAD    FILENAME  = TRIM(REPLACE(FILENAME,&LCASE,&UCASE))
  70.     INPUT(.LIB, 16, 120, FILENAME)        :S(SLOAD_0)F(FRETURN)
  71. SLOAD_0    MAX_SAV   =    &MAXLNGTH
  72.     TRIM_SAV  =    &TRIM
  73.     &MAXLNGTH =    32767
  74.     &TRIM     =    1
  75.  
  76. *    Read file, discarding control and comment lines
  77. SLOAD_1    X      =    LIB            :F(SLOAD_2)
  78.     X SLOAD_CCPAT                :S(SLOAD_1)
  79.     X      =    ';' X
  80.     X SLOAD_CNPAT =    ' '
  81.     X SLOAD_STMTS
  82.     CODE      =    CODE X            :(SLOAD_1)
  83.  
  84. SLOAD_2    ENDFILE(16)
  85.     CODE      =    CODE(CODE '; :(SLOAD_3)')    :S<CODE>
  86.     SCREEN      =    'Compilation error, file: ' FILENAME
  87.  
  88. * Error. Take CODE apart statement by statement to find the problem.
  89. * Remove initial ';'
  90.     CODE LEN(1) REM . CODE
  91. SLOAD_6    CODE FENCE SLOAD_STMT . X =        :F(SLOAD_7)
  92.     CODE(X)                    :S(SLOAD_6)
  93.     X RTAB(1) . SCREEN
  94. SLOAD_7    &MAXLNGTH =    MAX_SAV
  95.     &TRIM      =    TRIM_SAV
  96.     SCREEN      =    &ERRTEXT        :(FRETURN)
  97.  
  98. SLOAD_3    &MAXLNGTH =    MAX_SAV
  99.     &TRIM      =    TRIM_SAV        :(RETURN)
  100. END
  101.