![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to runFp.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / fp|
Return to runFp.l CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / fp |
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.