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