![[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.