Return to runFp.l CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / fp

Annotation of 42BSD/ucb/fp/runFp.l, revision 1.1

1.1     ! root        1: (setq SCCS-runFp.l "@(#)runFp.l        1.2     4/29/83")
        !             2: ;  FP interpreter/compiler
        !             3: ;  Copyright (c) 1982  Scott B. Baden
        !             4: ;  Berkeley, California
        !             5: 
        !             6: ; FASL (or load if no object files exist) then run FP.
        !             7: ; also set up  user-top-level to 'runFp'.
        !             8: 
        !             9: (include specials.l)
        !            10: 
        !            11: (declare
        !            12:   (localf make_chset setup init addHelp initHelp)
        !            13:   (special user-top-level))
        !            14: 
        !            15: (sstatus translink on)
        !            16: 
        !            17: (mapcar  'load 
        !            18:   '(fpMain handlers scanner parser codeGen primFp utils fpPP fpMeasures))
        !            19: 
        !            20: 
        !            21: (defun runFp nil
        !            22:   (cond ((null (make_chset))
        !            23:         (patom "Illegal Character set")
        !            24:         (terpri)
        !            25:         (exit))
        !            26:        
        !            27:        (t
        !            28:         (setup)                                        ; set up FP syntax funnies
        !            29:         (init)
        !            30:         (Tyi)
        !            31:         (msg N "FP, v. 4.2, (4/28/83)" N (B 6))))
        !            32:   
        !            33:   (setq user-top-level 'res_fp)                ; from now on just resume FP--
        !            34:   ; no need for extensive initializations
        !            35:   
        !            36:   (signal 2 'break-resp)
        !            37:   (fpMain nil t))                      ; invoke fp, exit to shell when done
        !            38: 
        !            39: (defun res_fp nil                      ; restart fp after infinite recursion,
        !            40:                                        ; simpler initializatin than runFp.
        !            41:    (signal 2 'break-resp)
        !            42:    (msg N (B 6))
        !            43:    (setq in_def nil infile nil outfile nil fn_name 'tmp$$ in_buf nil)
        !            44:    (setq level 0)
        !            45:    (fpMain nil t))
        !            46: 
        !            47: 
        !            48: (defun make_chset nil
        !            49:   (putprop 'fonts "+-,>!%&*/:=@{}()[]?~TF;#" 'asc)
        !            50:   (cond ((null (setq rsrvd (get 'fonts char_set))))
        !            51:        (t (setq e_rsrvd (explodec rsrvd)))))
        !            52: 
        !            53: 
        !            54: (defun setup nil
        !            55:   (setq newreadtable (makereadtable nil))
        !            56:   (let ((readtable newreadtable))
        !            57:        (mapcar '(lambda (z) (setsyntax z 66)) (exploden rsrvd))
        !            58:        (setsyntax #/< 'macro 'readit))
        !            59:   
        !            60:   (setsyntax #/< 'macro 'readit))
        !            61: 
        !            62: 
        !            63: (defun init nil
        !            64:   ; these are the only chars which may delimit numbers
        !            65:   ; (select operator)
        !            66:   
        !            67:   (setq num_delim$ '(#/, #/] #/@ #/: #/} 41 59 32 9 10 #/-))
        !            68:   
        !            69:   (setq timeIt nil)
        !            70:   (setq char_set (concat 'scan$ char_set))
        !            71:   (setq in_def nil)
        !            72:   (setq infile nil)
        !            73:   (setq outfile nil)
        !            74:   (setq fn_name 'tmp$$)
        !            75:   (setq in_buf nil)
        !            76:   (setq level 0)               ; initialize level to 0
        !            77:   (setq TracedFns nil) ; just to make sure TracedFns is defined
        !            78:   (setq DynTraceFlg nil) ; default of no dynamic tracing
        !            79:   
        !            80:   
        !            81:   
        !            82:   ; These are the builtin function names
        !            83:   
        !            84:   (setq builtins 
        !            85:        '(
        !            86:          out                                   ; output fn - for debug only
        !            87:          tl                                    ; left tail
        !            88:          id                                    ; id
        !            89:          atom                                  ; atom
        !            90:          eq                                    ; equal
        !            91:          not                                   ; not
        !            92:          and                                   ; and
        !            93:          or                                    ; or
        !            94:          xor                                   ; xor
        !            95:          null                                  ; null
        !            96:          iota                                  ; counting sequence generator
        !            97:          ; (library functions)
        !            98:          sin
        !            99:          asin
        !           100:          cos
        !           101:          acos
        !           102:          log                                   ; natural
        !           103:          exp
        !           104:          mod
        !           105:          ; (unary origin)
        !           106:          first                                 ; the first element
        !           107:          last                                  ; the last element
        !           108:          front                                 ; all except last
        !           109:          pick                                  ; get nth element
        !           110:          concat                                ; concat
        !           111:          pair                                  ; makes pairs
        !           112:          split                                 ; splits into two
        !           113:          reverse                               ; reverse
        !           114:          distl                                 ; distribute left
        !           115:          distr                                 ; distribute right
        !           116:          length                                ; length
        !           117:          trans                                 ; transpose
        !           118:          while                                 ; while
        !           119:          apndl                                 ; append left
        !           120:          apndr                                 ; append right
        !           121:          tlr                                   ; right tail
        !           122:          rotl                                  ; rotate left
        !           123:          rotr))                                ; rotate right
        !           124:   
        !           125:   (initStats)
        !           126:   (initHelp))
        !           127: 
        !           128: (defun addHelp (text cmd)
        !           129:   (putprop 'helpCmd text cmd))
        !           130: 
        !           131: (defun initHelp nil
        !           132:   (addHelp "fsave <file>                       Same as csave except without pretty-printing" 'fsave)
        !           133:   (addHelp "cload <file>                       Load Lisp code from a file (may be compiled)" 'cload)
        !           134:   (addHelp "csave <file>                       Output Lisp code for all user-defined fns" 'csave)
        !           135:   (addHelp "debug on/off                       Turn debugger output on/off" 'debug)
        !           136:   (addHelp "lisp                               Exit to the lisp system (return with '^D')" 'help)
        !           137:   (addHelp "help               This text" 'help)
        !           138:   (addHelp "script open/close/append [file] Open or close a script-file" 'script)
        !           139:   (addHelp "timer on/off                       Turn timer on/off" 'timing)
        !           140:   (addHelp "trace on/off <fn1> ...             Start/Stop exec trace of <fn1> ..." 'trace)
        !           141:   (addHelp "stats on/off/reset/print [file] collect and output dynamic stats" 'stats)
        !           142:   (addHelp "fns                                List all functions" 'fns)
        !           143:   (addHelp "delete <fn1> ...           Delete <fn1> ..." 'delete)
        !           144:   (addHelp "pfn <fn1> ...                      Print source text of <fn1> ..." 'pfn)
        !           145:   (addHelp "save <file>                        Save defined fns in <file>" 'save)
        !           146:   (addHelp "load <file>                        Redirect input from <file>" 'load)
        !           147:   )
        !           148: 
        !           149: 
        !           150:   (setq user-top-level 'runFp)
        !           151:   (setq char_set 'asc)                 ; set to the type of character set
        !           152:                                        ; desired at the moment only ascii (asc)
        !           153:                                        ; supported (no APL at this time).
        !           154: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.